Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORDEA01B

ORDEA01B.m

Go to the documentation of this file.
ORDEA01B ;ISP/RFR - DEA REPORTS 02;10/15/2014  08:02
 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**218,350**;Dec 17, 1997;Build 77
 Q
FEEDEA ;List those Fee Basis and C & A providers without a DEA number
 ;REP IS HANDLED BY REPORTS^ORDEA01
 W !!,"This report identifies Fee Basis and C & A providers who do not have a DEA#",!
 W "value in the NEW PERSON file (#200). These providers will need values entered",!
 W "into the DEA# (#53.2) and DEA EXPIRATION DATE (#747.44) fields in the",!
 W "NEW PERSON file (#200) before they can order controlled substances.",!
 N DISINC,DIV,SAVE,X
 S DISINC=$$DISPRMPT^ORDEA01()
 Q:DISINC=U
 S X=$$DIVPRMPT^ORUTL(.DIV)
 Q:X<1
 S SAVE("DISINC")="",SAVE("DIV(")=""
 D DEVICE^ORUTL($P(REP(REP),";",3),"OR "_$$UP^XLFSTR($P(REP(REP),";")),"Q",.SAVE)
 Q
FEEDEAQ ;TASKMAN ENTRY POINT
 ;CBUFFER IS HANDLED BY DEVICE^ORUTL OR TASKMAN
 N PROVIDERS,ERROR,IN,IDX,STATUS,DATA,PGNUM,COL,STOP,OUTPUT
 S IN=$NA(^TMP("DILIST",$J)) K @IN
 S DATA=$NA(^TMP($J,"ORFEEDATA")) K @DATA
 D LIST^DIC(200,,"@;.01;53.6;9.2I","P",,,,,"I ""^3^4^""[(U_$P($G(^VA(200,Y,""PS"")),U,6)_U)&($P($G(^VA(200,Y,""PS"")),U,2)="""")",,,"ERROR")
 I $D(ERROR) D  Q
 .D FMERROR^ORUTL(.ERROR)
 .S:$D(ZTQUEUED) ZTREQ="@"
 S COL(2)=$$REPEAT^XLFSTR(" ",37)_"PROVIDER   TERMINATION  ACCOUNT"
 S COL(3)=$$LJ^XLFSTR("PROVIDER NAME",35," ")_"    TYPE        DATE      STATUS"
 I '$D(@IN) D  Q
 .S STOP=$$HEADER^ORUTL("FEE BASIS/C & A PROVIDER MISSING DEA# REPORT",.PGNUM,.COL)
 .Q:STOP
 .W !,$$CJ^XLFSTR("0 PROVIDERS FOUND",$S(+$G(IOM)>0:(IOM-1),1:79)," "),!
 .S:$D(ZTQUEUED) ZTREQ="@"
 S IDX=0 F  S IDX=$O(@IN@(IDX)) Q:+$G(IDX)=0  D
 .N DIVISION S DIVISION=$$HASDIV^ORUTL($P(@IN@(IDX,0),U),.DIV)
 .Q:DIVISION=""
 .N STATUS S STATUS=$$ACTIVE^XUSER($P(@IN@(IDX,0),U,1))
 .I 'DISINC,(+STATUS<1),($P(STATUS,U,2)'="") Q
 .;INCLUDE USERS WHO CANNOT SIGN-ON IN ACTIVE LISTING
 .S STATUS("TEXT")=$S($P(STATUS,U,2)'="":$P(STATUS,U,2),STATUS=0:"CANNOT SIGN ON",1:"UNKNOWN")
 .I STATUS=0 S STATUS=1
 .N DATE,IDATE S DATE=+$P(@IN@(IDX,0),U,4),IDATE=9999999-DATE S DATE=$$LJ^XLFSTR($S(DATE>0:$$FMTE^XLFDT(DATE,"5D"),1:""),11," ")
 .S @DATA@(DIVISION,+STATUS,IDATE,$P(@IN@(IDX,0),U,2))=$$LJ^XLFSTR($P(@IN@(IDX,0),U,2),35," ")_"  "_$$LJ^XLFSTR($P(@IN@(IDX,0),U,3),9)_"  "_DATE_"  "_STATUS("TEXT")
 N DIVISION S DIVISION="" F  S DIVISION=$O(@DATA@(DIVISION)) Q:$G(DIVISION)=""!($G(STOP))  D
 .S COL(1)="DIVISION: "_DIVISION
 .S STOP=$$HEADER^ORUTL("FEE BASIS/C & A PROVIDER MISSING DEA# REPORT",.PGNUM,.COL)
 .Q:STOP
 .N STATUS F STATUS=1:-1:0  D  Q:STOP
 ..Q:'$D(@DATA@(DIVISION,STATUS))
 ..I STATUS=0 D  Q:STOP
 ...I ($Y+4+CBUFFER)>IOSL S STOP=$$HEADER^ORUTL("FEE BASIS/C & A PROVIDER MISSING DEA# REPORT",.PGNUM,.COL)
 ...Q:STOP
 ...W:$Y>5 !
 ...W $$CJ^XLFSTR("*** DISUSERED/TERMINATED USERS ***",$S(+$G(IOM)>0:(IOM-1),1:79)," "),!
 ...W $$CJ^XLFSTR($$REPEAT^XLFSTR("-",34),$S(+$G(IOM)>0:(IOM-1),1:79)," "),!
 ..S IDATE=0 F  S IDATE=$O(@DATA@(DIVISION,STATUS,IDATE)) Q:+$G(IDATE)=0!(STOP)  D
 ...N NAME S NAME="" F  S NAME=$O(@DATA@(DIVISION,STATUS,IDATE,NAME)) Q:$G(NAME)=""!(STOP)  D
 ....I ($Y+CBUFFER)>IOSL D  Q:STOP
 .....S STOP=$$HEADER^ORUTL("FEE BASIS/C & A PROVIDER MISSING DEA# REPORT",.PGNUM,.COL)
 ....W @DATA@(DIVISION,STATUS,IDATE,NAME)
 ....I ($Y+1)<IOSL W !
 ....S OUTPUT=1
 I '$G(STOP) D
 .I '$G(OUTPUT) D  Q:$G(STOP)
 ..S STOP=$$HEADER^ORUTL("FEE BASIS/C & A PROVIDER MISSING DEA# REPORT",.PGNUM,.COL)
 ..Q:STOP
 ..W !,$$CJ^XLFSTR("0 PROVIDERS FOUND",$S(+$G(IOM)>0:(IOM-1),1:79)," "),!
 .I ($Y+2)>IOSL S STOP=$$HEADER^ORUTL("FEE BASIS/C & A PROVIDER MISSING DEA# REPORT",.PGNUM,.COL)
 .Q:$G(STOP)
 .W !,$$CJ^XLFSTR("[END OF REPORT]",$S(+$G(IOM)>0:(IOM-1),1:79)," ")
 K @IN,@DATA
 S:$D(ZTQUEUED) ZTREQ="@"
 Q
AUDIT ;Display the audit data for OE/RR EPCS PARAMTERS file (#100.7)
 ;REP IS HANDLED BY REPORTS^ORDEA01
 W !!,"This report displays the audit data for the logical access control feature.",!
 N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,ORCDATE,ORDDATE,DIV
 S DIR(0)="DO"_U_":"_DT_":EP"
 S DIR("A")="START DATE"
 S DIR("?",1)="The report will not display audit data created before this date."
 S DIR("?")="To display all audit data, leave this field blank."
 D ^DIR
 Q:$D(DTOUT)!($D(DUOUT))
 S ORCDATE=+$G(Y)
 K X,Y,DTOUT,DUOUT,DIRUT,DIROUT
 S DIR("A")="END DATE"
 S DIR("?",1)="The report will not display audit data created after this date."
 I ORCDATE>0 S DIR("?")="To display all audit data created through the date the report runs, leave this field blank."
 D ^DIR
 Q:$D(DTOUT)!($D(DUOUT))
 S ORDDATE=+$G(Y)
 S X=$$DIVPRMPT^ORUTL(.DIV)
 Q:X<1
 S SAVE("ORCDATE")="",SAVE("ORDDATE")="",SAVE("DIV(")=""
 D DEVICE^ORUTL($P(REP(REP),";",3),"OR "_$$UP^XLFSTR($P(REP(REP),";")),"Q",.SAVE)
 Q
AUDITQ ;TASKMAN ENTRY POINT
 ;CBUFFER IS HANDLED BY DEVICE^ORUTL OR TASKMAN
 N ORDATE,ORDATA,ORSITE,PGNUM,ORDUZ,ORDIVISION
 S ORDATA=$NA(^TMP($J,"ORAUDITDATA")) K @ORDATA
 I 'ORDDATE S ORDDATE=DT+0.235959
 E  S ORDDATE=ORDDATE+0.235959
 S ORDATE=ORCDATE F  S ORDATE=$O(^DIA(100.7,"C",ORDATE)) Q:ORDATE=""!(ORDATE>ORDDATE)  D
 .N ORIEN
 .S ORIEN=0 F  S ORIEN=$O(^DIA(100.7,"C",ORDATE,ORIEN)) Q:ORIEN=""  D
 ..N ORNAME,ORACTION,ORTEXT,ORFIELD,OROUTPUT,ORCOUNT,ORITM
 ..S ORFIELD=$P($G(^DIA(100.7,ORIEN,0)),U,3)
 ..S ORNAME=$P($G(^DIA(100.7,ORIEN,3.1)),U)
 ..S:$G(ORNAME)="" ORNAME=$P($G(^DIA(100.7,ORIEN,2.1)),U)
 ..I ORFIELD="1,.01" D  Q:ORDIVISION=""
 ...S ORDIVISION=$$HASDIV^ORUTL(ORNAME,.DIV)
 ..I $D(^DIA(100.7,ORIEN,2.1))=1,'$D(^DIA(100.7,ORIEN,3.1)) S ORACTION="Disabled",ORNAME(1)=$G(^DIA(100.7,ORIEN,2))
 ..I '$D(^DIA(100.7,ORIEN,2.1)),$D(^DIA(100.7,ORIEN,3.1))=1 S ORACTION="Enabled",ORNAME(1)=$G(^DIA(100.7,ORIEN,3))
 ..I $D(^DIA(100.7,ORIEN,2.1))=1,$D(^DIA(100.7,ORIEN,3.1))=1 D
 ...I ORFIELD=.02 S ORACTION=$S($G(^DIA(100.7,ORIEN,2))="YES":"Disabled",1:"Enabled")
 ...E  S ORACTION="Modified"
 ...S ORNAME(1)=$G(^DIA(100.7,ORIEN,3))
 ..I ORFIELD=.01 D  Q
 ...S $P(@ORDATA@("TOP",$P($G(^DIA(100.7,ORIEN,0)),U)),U,3)=ORNAME(1)
 ..S ORNAME("USER")=$$GET1^DIQ(200,$P($G(^DIA(100.7,ORIEN,0)),U,4)_",",.01)
 ..S:ORNAME("USER")="" ORNAME("USER")="User #"_$P($G(^DIA(100.7,ORIEN,0)),U,4)
 ..S ORTEXT=ORACTION_" on "_$$FMTE^XLFDT(ORDATE)_" by "_ORNAME("USER")
 ..I $P($G(^DIA(100.7,ORIEN,4.1)),U)'="" S ORTEXT=ORTEXT_" with option "_$$GET1^DIQ(19,$P($G(^DIA(100.7,ORIEN,4.1)),U)_",",.01)
 ..I ORFIELD=.02,ORACTION="Modified" S ORTEXT=ORTEXT_" from "_$G(^DIA(100.7,ORIEN,2))_" to "_ORNAME(1)
 ..S ORTEXT=ORTEXT_"."
 ..I ORFIELD="1,.01" S OROUTPUT=$NA(@ORDATA@(ORDIVISION,ORNAME,ORIEN))
 ..E  S OROUTPUT=$NA(@ORDATA@("TOP",$P($G(^DIA(100.7,ORIEN,0)),U),ORIEN))
 ..S ORITM=1+$P($G(@($P(OROUTPUT,","_ORIEN_")")_")")),U,2),ORTEXT=$$PAD^ORUTL(ORITM,3)_ORITM_": "_ORTEXT
 ..D WRAP^ORUTL(ORTEXT,OROUTPUT)
 ..S ORCOUNT=@OROUTPUT
 ..S OROUTPUT=$P(OROUTPUT,","_ORIEN_")")_")",$P(@OROUTPUT,U)=ORCOUNT+$G(@OROUTPUT),$P(@OROUTPUT,U,2)=1+$P($G(@OROUTPUT),U,2)
 ..I ORFIELD'=.02 S $P(@OROUTPUT,U,3)=ORNAME(1)
 S STOP=$$HEADER^ORUTL("LOGICAL ACCESS CONTROL AUDIT REPORT",.PGNUM)
 Q:STOP
 S ORSITE(1)=$O(^ORD(100.7,0)),ORSITE=$$GET1^DIQ(100.7,ORSITE(1)_",",.01)
 I ORSITE="" S ORSITE=$P(@ORDATA@("TOP",ORSITE(1)),U,3)
 W "SITE: "_ORSITE
 S ORDIEN=0 F  S ORDIEN=$O(@ORDATA@("TOP",ORSITE(1),ORDIEN)) Q:ORDIEN=""!(STOP)  D
 .N ORLINE
 .S ORLINE=0 F  S ORLINE=$O(@ORDATA@("TOP",ORSITE(1),ORDIEN,ORLINE)) Q:ORLINE=""!(STOP)  D
 ..I ($Y+CBUFFER+1)>IOSL D  Q:STOP
 ...S STOP=$$HEADER^ORUTL("LOGICAL ACCESS CONTROL AUDIT REPORT",.PGNUM)
 ..W !,@ORDATA@("TOP",ORSITE(1),ORDIEN,ORLINE)
 Q:STOP
 S ORDIVISION="" F  S ORDIVISION=$O(@ORDATA@(ORDIVISION)) Q:ORDIVISION=""!(STOP)  D
 .Q:ORDIVISION="TOP"
 .I ($Y+CBUFFER+2)>IOSL D  Q:STOP
 ..S STOP=$$HEADER^ORUTL("LOGICAL ACCESS CONTROL AUDIT REPORT",.PGNUM)
 .W !!,"DIVISION: "_ORDIVISION
 .S ORDUZ=0 F  S ORDUZ=$O(@ORDATA@(ORDIVISION,ORDUZ)) Q:ORDUZ=""!(STOP)  D
 ..I ($Y+CBUFFER+@ORDATA@(ORDIVISION,ORDUZ))>IOSL D  Q:STOP
 ...S STOP=$$HEADER^ORUTL("LOGICAL ACCESS CONTROL AUDIT REPORT",.PGNUM)
 ..N ORDIEN,ORUSER
 ..S ORUSER=$$GET1^DIQ(200,ORDUZ_",",.01)
 ..S:ORUSER="" ORUSER=$P(@ORDATA@(ORDIVISION,ORDUZ),U,3)
 ..W !,"USER: "_ORUSER
 ..S ORDIEN=0 F  S ORDIEN=$O(@ORDATA@(ORDIVISION,ORDUZ,ORDIEN)) Q:ORDIEN=""  D
 ...N ORLINE
 ...S ORLINE=0 F  S ORLINE=$O(@ORDATA@(ORDIVISION,ORDUZ,ORDIEN,ORLINE)) Q:ORLINE=""  D
 ....W !,@ORDATA@(ORDIVISION,ORDUZ,ORDIEN,ORLINE)
 K @ORDATA
 S:$D(ZTQUEUED) ZTREQ="@"
 Q
LAST ;List those providers that contain a space and/or punctuation in the last name
 ;REP IS HANDLED BY REPORTS^ORDEA01
 W !!,"This report identifies providers with one or more space or punctuation",!
 W "characters in their family (last) name. These providers may not be able to",!
 W "link their PIV card using CPRS GUI. For these providers, someone may have",!
 W "to use the Data Entry for e-Prescribing Controlled Substances GUI and",!
 W "manually enter the subject alternative name stored on the provider's PIV",!
 W "card.",!!
 W "Additionally, it is recommended that for those providers who's NAME COMPONENTS",!
 W "file (#20) entry does not exactly match the value in the NAME field (#.01) in",!
 W "the NEW PERSON file (#200), either the NAME COMPONENTS file entry or the value",!
 W "in the NAME field in the NEW PERSON file are modified so that both are the same.",!
 N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,DISINC,DIV,SCREEN2,SAVE
 S DISINC=$$DISPRMPT^ORDEA01()
 Q:DISINC=U
 W !
 S DIR(0)="Y"_U
 S DIR("A",1)="Do you want to include providers who have already linked their PIV card"
 S DIR("A")="with their VistA account"
 S DIR("B")="NO"
 D ^DIR
 Q:$D(DIRUT)
 I 'Y S SCREEN2="I $$GET1^DIQ(200,Y_"","",501.2)="""""
 S X=$$DIVPRMPT^ORUTL(.DIV)
 Q:X<1
 S SAVE("DISINC")="",SAVE("DIV(")=""
 S:$D(SCREEN2) SAVE("SCREEN2")=""
 D DEVICE^ORUTL($P(REP(REP),";",3),"OR "_$$UP^XLFSTR($P(REP(REP),";")),"Q",.SAVE)
 Q
LASTQ ;TASKMAN ENTRY POINT
 ;CBUFFER IS HANDLED BY DEVICE^ORUTL OR TASKMAN
 N Y,OUT,DATA,REASON,PGNUM,COL,STOP,OUTPUT,DHEADER
 S DATA=$NA(^TMP($J,"ORLASTMP")) K @DATA
 S COL(2)=$$LJ^XLFSTR("PROVIDER NAME",37," ")_"ACCOUNT STATUS"
 S REASON="THE NAME COMPONENTS FILE (#20) ENTRY DOES NOT MATCH THE NAME FIELD (#.01) IN THE "
 S REASON=REASON_"NEW PERSON FILE (#200)."
 ;IA #10076
 S Y=0 F  S Y=$O(^XUSEC("ORES",Y)) Q:+$G(Y)=0  D
 .N STATUS S STATUS=$$ACTIVE^XUSER(Y)
 .I 'DISINC,(+STATUS<1),($P(STATUS,U,2)'="") Q
 .;INCLUDE USERS WHO CANNOT SIGN-ON IN ACTIVE LISTING
 .S STATUS("TEXT")=$S($P(STATUS,U,2)'="":$P(STATUS,U,2),STATUS=0:"CANNOT SIGN ON",1:"UNKNOWN")
 .I STATUS=0 S STATUS=1
 .N DIVISION S DIVISION=$$HASDIV^ORUTL(Y,.DIV)
 .Q:DIVISION=""
 .I $D(SCREEN2) X SCREEN2 I '$T Q
 .N ONAME,CNAME,ITEM
 .S ONAME=$$GET1^DIQ(200,Y_",",.01)
 .D NAMECOMP^XLFNAME(.ONAME)
 .S ONAME("STRIPPED")=$$STRIP^ORDEA01A(ONAME("FAMILY"))
 .S CNAME("FILE")=200,CNAME("FIELD")=.01,CNAME("IENS")=Y_","
 .S CNAME=$$NAMEFMT^XLFNAME(.CNAME,"F","C")
 .D NAMECOMP^XLFNAME(.CNAME)
 .S CNAME("STRIPPED")=$$STRIP^ORDEA01A(CNAME("FAMILY"))
 .I ONAME("FAMILY")'=ONAME("STRIPPED") S @DATA@(DIVISION,+STATUS,ONAME)=STATUS("TEXT")
 .I ONAME("FAMILY")=ONAME("STRIPPED")&(CNAME("FAMILY")'=CNAME("STRIPPED")) D
 ..S @DATA@(DIVISION,+STATUS,ONAME)=STATUS("TEXT")
 ..S @DATA@(DIVISION,+STATUS,ONAME,CNAME)=""
 .F ITEM="FAMILY","GIVEN","MIDDLE","SUFFIX" D
 ..I ONAME(ITEM)'=CNAME(ITEM) D
 ...S @DATA@(DIVISION,+STATUS,ONAME)=STATUS("TEXT")
 ...S @DATA@(DIVISION,+STATUS,ONAME,CNAME)=REASON
 N DIVISION S DIVISION="" F  S DIVISION=$O(@DATA@(DIVISION)) Q:$G(DIVISION)=""!($G(STOP))  D
 .S COL(1)="DIVISION: "_DIVISION
 .S STOP=$$HEADER^ORUTL("PROVIDER LAST NAME REPORT",.PGNUM,.COL)
 .Q:STOP
 .S DHEADER=0
 .N STATUS F STATUS=1:-1:0  D  Q:STOP
 ..N NAME S NAME="" F  S NAME=$O(@DATA@(DIVISION,STATUS,NAME)) Q:$G(NAME)=""!(STOP)  D
 ...N NAMEC,OUT S NAMEC="" F  S NAMEC=$O(@DATA@(DIVISION,STATUS,NAME,NAMEC)) Q:$G(NAMEC)=""!(STOP)  D
 ....D WRAP^ORUTL("    NAME COMPONENTS: "_NAMEC,"OUT") S OUT=OUT+1
 ....I $G(@DATA@(DIVISION,STATUS,NAME,NAMEC))'="" D WRAP^ORUTL("    "_@DATA@(DIVISION,STATUS,NAME,NAMEC),"OUT")
 ...I ($Y+$G(OUT)+CBUFFER+$S(STATUS=0&('DHEADER):3,1:0))>IOSL D  Q:STOP
 ....S STOP=$$HEADER^ORUTL("PROVIDER LAST NAME REPORT",.PGNUM,.COL)
 ...I STATUS=0,('DHEADER) D
 ....W:$Y>4 !
 ....W $$CJ^XLFSTR("*** DISUSERED/TERMINATED USERS ***",$S(+$G(IOM)>0:(IOM-1),1:79)," "),!
 ....W $$CJ^XLFSTR($$REPEAT^XLFSTR("-",34),$S(+$G(IOM)>0:(IOM-1),1:79)," "),!
 ....S DHEADER=1
 ...W $$LJ^XLFSTR(NAME,37," ")_@DATA@(DIVISION,STATUS,NAME),!
 ...S OUT=0 F  S OUT=$O(OUT(OUT)) Q:'OUT  W OUT(OUT) I ($Y+1)<IOSL W !
 ...S OUTPUT=1
 I '$G(STOP) D
 .I '$G(OUTPUT) D  Q:$G(STOP)
 ..S STOP=$$HEADER^ORUTL("PROVIDER LAST NAME REPORT",.PGNUM,.COL)
 ..Q:STOP
 ..W !,$$CJ^XLFSTR("No family (last) name issues found.",$S(+$G(IOM)>0:(IOM-1),1:79)," "),!
 .I ($Y+2)>IOSL S STOP=$$HEADER^ORUTL("PROVIDER LAST NAME REPORT",.PGNUM,.COL)
 .Q:$G(STOP)
 .W !,$$CJ^XLFSTR("[END OF REPORT]",$S(+$G(IOM)>0:(IOM-1),1:79)," ")
 K @DATA
 S:$D(ZTQUEUED) ZTREQ="@"
 Q