ORDEA01B.m

ORDEA01B ;ISP/RFR - DEA REPORTS 02;10/15/2014  08:02

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**218,350,499**;Dec 17, 1997;Build 165

 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 a valid DEA ",!

 W "number entered into the NEW DEA# (#53.21) field in the NEW PERSON file (#200) ",!

 W "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

 ;*499 introduces multiple dea's for provider

 D LIST^DIC(200,,"@;.01;53.6;9.2I","P",,,,,"I ""^3^4^""[(U_$P($G(^VA(200,Y,""PS"")),U,6)_U)&'($L($$PRDEA^XUSER(Y)))",,,"ERROR")

 ;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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ORDEA01B   13238     printed  Mar 13, 2025@21:34:52                                                                                                                                                                                                   Page 2

ORDEA01B  ;ISP/RFR - DEA REPORTS 02;10/15/2014  08:02

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**218,350,499**;Dec 17, 1997;Build 165

 +2        QUIT 

FEEDEA    ;List those Fee Basis and C & A providers without a DEA number

 +1       ;REP IS HANDLED BY REPORTS^ORDEA01

 +2        WRITE !!,"This report identifies Fee Basis and C & A providers who do not have a DEA# ",!

 +3        WRITE "value in the NEW PERSON file (#200). These providers will need a valid DEA ",!

 +4        WRITE "number entered into the NEW DEA# (#53.21) field in the NEW PERSON file (#200) ",!

 +5        WRITE "before they can order controlled substances.",!

 +6        NEW DISINC,DIV,SAVE,X

 +7        SET DISINC=$$DISPRMPT^ORDEA01()

 +8        if DISINC=U

               QUIT 

 +9        SET X=$$DIVPRMPT^ORUTL(.DIV)

 +10       if X<1

               QUIT 

 +11       SET SAVE("DISINC")=""

           SET SAVE("DIV(")=""

 +12       DO DEVICE^ORUTL($PIECE(REP(REP),";",3),"OR "_$$UP^XLFSTR($PIECE(REP(REP),";")),"Q",.SAVE)

 +13       QUIT 

FEEDEAQ   ;TASKMAN ENTRY POINT

 +1       ;CBUFFER IS HANDLED BY DEVICE^ORUTL OR TASKMAN

 +2        NEW PROVIDERS,ERROR,IN,IDX,STATUS,DATA,PGNUM,COL,STOP,OUTPUT

 +3        SET IN=$NAME(^TMP("DILIST",$JOB))

           KILL @IN

 +4        SET DATA=$NAME(^TMP($JOB,"ORFEEDATA"))

           KILL @DATA

 +5       ;*499 introduces multiple dea's for provider

 +6        DO LIST^DIC(200,,"@;.01;53.6;9.2I","P",,,,,"I ""^3^4^""[(U_$P($G(^VA(200,Y,""PS"")),U,6)_U)&'($L($$PRDEA^XUSER(Y)))",,,"ERROR")

 +7       ;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")

 +8        IF $DATA(ERROR)

               Begin DoDot:1

 +9                DO FMERROR^ORUTL(.ERROR)

 +10               if $DATA(ZTQUEUED)

                       SET ZTREQ="@"

               End DoDot:1

               QUIT 

 +11       SET COL(2)=$$REPEAT^XLFSTR(" ",37)_"PROVIDER   TERMINATION  ACCOUNT"

 +12       SET COL(3)=$$LJ^XLFSTR("PROVIDER NAME",35," ")_"    TYPE        DATE      STATUS"

 +13       IF '$DATA(@IN)

               Begin DoDot:1

 +14               SET STOP=$$HEADER^ORUTL("FEE BASIS/C & A PROVIDER MISSING DEA# REPORT",.PGNUM,.COL)

 +15               if STOP

                       QUIT 

 +16               WRITE !,$$CJ^XLFSTR("0 PROVIDERS FOUND",$SELECT(+$GET(IOM)>0:(IOM-1),1:79)," "),!

 +17               if $DATA(ZTQUEUED)

                       SET ZTREQ="@"

               End DoDot:1

               QUIT 

 +18       SET IDX=0

           FOR 

               SET IDX=$ORDER(@IN@(IDX))

               if +$GET(IDX)=0

                   QUIT 

               Begin DoDot:1

 +19               NEW DIVISION

                   SET DIVISION=$$HASDIV^ORUTL($PIECE(@IN@(IDX,0),U),.DIV)

 +20               if DIVISION=""

                       QUIT 

 +21               NEW STATUS

                   SET STATUS=$$ACTIVE^XUSER($PIECE(@IN@(IDX,0),U,1))

 +22               IF 'DISINC

                       IF (+STATUS<1)

                           IF ($PIECE(STATUS,U,2)'="")

                               QUIT 

 +23      ;INCLUDE USERS WHO CANNOT SIGN-ON IN ACTIVE LISTING

 +24               SET STATUS("TEXT")=$SELECT($PIECE(STATUS,U,2)'="":$PIECE(STATUS,U,2),STATUS=0:"CANNOT SIGN ON",1:"UNKNOWN")

 +25               IF STATUS=0

                       SET STATUS=1

 +26               NEW DATE,IDATE

                   SET DATE=+$PIECE(@IN@(IDX,0),U,4)

                   SET IDATE=9999999-DATE

                   SET DATE=$$LJ^XLFSTR($SELECT(DATE>0:$$FMTE^XLFDT(DATE,"5D"),1:""),11," ")

 +27               SET @DATA@(DIVISION,+STATUS,IDATE,$PIECE(@IN@(IDX,0),U,2))=$$LJ^XLFSTR($PIECE(@IN@(IDX,0),U,2),35," ")_"  "_$$LJ^XLFSTR($PIECE(@IN@(IDX,0),U,3),9)_"  "_DATE_"  "_STATUS("TEXT")

               End DoDot:1

 +28       NEW DIVISION

           SET DIVISION=""

           FOR 

               SET DIVISION=$ORDER(@DATA@(DIVISION))

               if $GET(DIVISION)=""!($GET(STOP))

                   QUIT 

               Begin DoDot:1

 +29               SET COL(1)="DIVISION: "_DIVISION

 +30               SET STOP=$$HEADER^ORUTL("FEE BASIS/C & A PROVIDER MISSING DEA# REPORT",.PGNUM,.COL)

 +31               if STOP

                       QUIT 

 +32               NEW STATUS

                   FOR STATUS=1:-1:0

                       Begin DoDot:2

 +33                       if '$DATA(@DATA@(DIVISION,STATUS))

                               QUIT 

 +34                       IF STATUS=0

                               Begin DoDot:3

 +35                               IF ($Y+4+CBUFFER)>IOSL

                                       SET STOP=$$HEADER^ORUTL("FEE BASIS/C & A PROVIDER MISSING DEA# REPORT",.PGNUM,.COL)

 +36                               if STOP

                                       QUIT 

 +37                               if $Y>5

                                       WRITE !

 +38                               WRITE $$CJ^XLFSTR("*** DISUSERED/TERMINATED USERS ***",$SELECT(+$GET(IOM)>0:(IOM-1),1:79)," "),!

 +39                               WRITE $$CJ^XLFSTR($$REPEAT^XLFSTR("-",34),$SELECT(+$GET(IOM)>0:(IOM-1),1:79)," "),!

                               End DoDot:3

                               if STOP

                                   QUIT 

 +40                       SET IDATE=0

                           FOR 

                               SET IDATE=$ORDER(@DATA@(DIVISION,STATUS,IDATE))

                               if +$GET(IDATE)=0!(STOP)

                                   QUIT 

                               Begin DoDot:3

 +41                               NEW NAME

                                   SET NAME=""

                                   FOR 

                                       SET NAME=$ORDER(@DATA@(DIVISION,STATUS,IDATE,NAME))

                                       if $GET(NAME)=""!(STOP)

                                           QUIT 

                                       Begin DoDot:4

 +42                                       IF ($Y+CBUFFER)>IOSL

                                               Begin DoDot:5

 +43                                               SET STOP=$$HEADER^ORUTL("FEE BASIS/C & A PROVIDER MISSING DEA# REPORT",.PGNUM,.COL)

                                               End DoDot:5

                                               if STOP

                                                   QUIT 

 +44                                       WRITE @DATA@(DIVISION,STATUS,IDATE,NAME)

 +45                                       IF ($Y+1)<IOSL

                                               WRITE !

 +46                                       SET OUTPUT=1

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

                       if STOP

                           QUIT 

               End DoDot:1

 +47       IF '$GET(STOP)

               Begin DoDot:1

 +48               IF '$GET(OUTPUT)

                       Begin DoDot:2

 +49                       SET STOP=$$HEADER^ORUTL("FEE BASIS/C & A PROVIDER MISSING DEA# REPORT",.PGNUM,.COL)

 +50                       if STOP

                               QUIT 

 +51                       WRITE !,$$CJ^XLFSTR("0 PROVIDERS FOUND",$SELECT(+$GET(IOM)>0:(IOM-1),1:79)," "),!

                       End DoDot:2

                       if $GET(STOP)

                           QUIT 

 +52               IF ($Y+2)>IOSL

                       SET STOP=$$HEADER^ORUTL("FEE BASIS/C & A PROVIDER MISSING DEA# REPORT",.PGNUM,.COL)

 +53               if $GET(STOP)

                       QUIT 

 +54               WRITE !,$$CJ^XLFSTR("[END OF REPORT]",$SELECT(+$GET(IOM)>0:(IOM-1),1:79)," ")

               End DoDot:1

 +55       KILL @IN,@DATA

 +56       if $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +57       QUIT 

AUDIT     ;Display the audit data for OE/RR EPCS PARAMTERS file (#100.7)

 +1       ;REP IS HANDLED BY REPORTS^ORDEA01

 +2        WRITE !!,"This report displays the audit data for the logical access control feature.",!

 +3        NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,ORCDATE,ORDDATE,DIV

 +4        SET DIR(0)="DO"_U_":"_DT_":EP"

 +5        SET DIR("A")="START DATE"

 +6        SET DIR("?",1)="The report will not display audit data created before this date."

 +7        SET DIR("?")="To display all audit data, leave this field blank."

 +8        DO ^DIR

 +9        if $DATA(DTOUT)!($DATA(DUOUT))

               QUIT 

 +10       SET ORCDATE=+$GET(Y)

 +11       KILL X,Y,DTOUT,DUOUT,DIRUT,DIROUT

 +12       SET DIR("A")="END DATE"

 +13       SET DIR("?",1)="The report will not display audit data created after this date."

 +14       IF ORCDATE>0

               SET DIR("?")="To display all audit data created through the date the report runs, leave this field blank."

 +15       DO ^DIR

 +16       if $DATA(DTOUT)!($DATA(DUOUT))

               QUIT 

 +17       SET ORDDATE=+$GET(Y)

 +18       SET X=$$DIVPRMPT^ORUTL(.DIV)

 +19       if X<1

               QUIT 

 +20       SET SAVE("ORCDATE")=""

           SET SAVE("ORDDATE")=""

           SET SAVE("DIV(")=""

 +21       DO DEVICE^ORUTL($PIECE(REP(REP),";",3),"OR "_$$UP^XLFSTR($PIECE(REP(REP),";")),"Q",.SAVE)

 +22       QUIT 

AUDITQ    ;TASKMAN ENTRY POINT

 +1       ;CBUFFER IS HANDLED BY DEVICE^ORUTL OR TASKMAN

 +2        NEW ORDATE,ORDATA,ORSITE,PGNUM,ORDUZ,ORDIVISION

 +3        SET ORDATA=$NAME(^TMP($JOB,"ORAUDITDATA"))

           KILL @ORDATA

 +4        IF 'ORDDATE

               SET ORDDATE=DT+0.235959

 +5       IF '$TEST

               SET ORDDATE=ORDDATE+0.235959

 +6        SET ORDATE=ORCDATE

           FOR 

               SET ORDATE=$ORDER(^DIA(100.7,"C",ORDATE))

               if ORDATE=""!(ORDATE>ORDDATE)

                   QUIT 

               Begin DoDot:1

 +7                NEW ORIEN

 +8                SET ORIEN=0

                   FOR 

                       SET ORIEN=$ORDER(^DIA(100.7,"C",ORDATE,ORIEN))

                       if ORIEN=""

                           QUIT 

                       Begin DoDot:2

 +9                        NEW ORNAME,ORACTION,ORTEXT,ORFIELD,OROUTPUT,ORCOUNT,ORITM

 +10                       SET ORFIELD=$PIECE($GET(^DIA(100.7,ORIEN,0)),U,3)

 +11                       SET ORNAME=$PIECE($GET(^DIA(100.7,ORIEN,3.1)),U)

 +12                       if $GET(ORNAME)=""

                               SET ORNAME=$PIECE($GET(^DIA(100.7,ORIEN,2.1)),U)

 +13                       IF ORFIELD="1,.01"

                               Begin DoDot:3

 +14                               SET ORDIVISION=$$HASDIV^ORUTL(ORNAME,.DIV)

                               End DoDot:3

                               if ORDIVISION=""

                                   QUIT 

 +15                       IF $DATA(^DIA(100.7,ORIEN,2.1))=1

                               IF '$DATA(^DIA(100.7,ORIEN,3.1))

                                   SET ORACTION="Disabled"

                                   SET ORNAME(1)=$GET(^DIA(100.7,ORIEN,2))

 +16                       IF '$DATA(^DIA(100.7,ORIEN,2.1))

                               IF $DATA(^DIA(100.7,ORIEN,3.1))=1

                                   SET ORACTION="Enabled"

                                   SET ORNAME(1)=$GET(^DIA(100.7,ORIEN,3))

 +17                       IF $DATA(^DIA(100.7,ORIEN,2.1))=1

                               IF $DATA(^DIA(100.7,ORIEN,3.1))=1

                                   Begin DoDot:3

 +18                                   IF ORFIELD=.02

                                           SET ORACTION=$SELECT($GET(^DIA(100.7,ORIEN,2))="YES":"Disabled",1:"Enabled")

 +19                                  IF '$TEST

                                           SET ORACTION="Modified"

 +20                                   SET ORNAME(1)=$GET(^DIA(100.7,ORIEN,3))

                                   End DoDot:3

 +21                       IF ORFIELD=.01

                               Begin DoDot:3

 +22                               SET $PIECE(@ORDATA@("TOP",$PIECE($GET(^DIA(100.7,ORIEN,0)),U)),U,3)=ORNAME(1)

                               End DoDot:3

                               QUIT 

 +23                       SET ORNAME("USER")=$$GET1^DIQ(200,$PIECE($GET(^DIA(100.7,ORIEN,0)),U,4)_",",.01)

 +24                       if ORNAME("USER")=""

                               SET ORNAME("USER")="User #"_$PIECE($GET(^DIA(100.7,ORIEN,0)),U,4)

 +25                       SET ORTEXT=ORACTION_" on "_$$FMTE^XLFDT(ORDATE)_" by "_ORNAME("USER")

 +26                       IF $PIECE($GET(^DIA(100.7,ORIEN,4.1)),U)'=""

                               SET ORTEXT=ORTEXT_" with option "_$$GET1^DIQ(19,$PIECE($GET(^DIA(100.7,ORIEN,4.1)),U)_",",.01)

 +27                       IF ORFIELD=.02

                               IF ORACTION="Modified"

                                   SET ORTEXT=ORTEXT_" from "_$GET(^DIA(100.7,ORIEN,2))_" to "_ORNAME(1)

 +28                       SET ORTEXT=ORTEXT_"."

 +29                       IF ORFIELD="1,.01"

                               SET OROUTPUT=$NAME(@ORDATA@(ORDIVISION,ORNAME,ORIEN))

 +30                      IF '$TEST

                               SET OROUTPUT=$NAME(@ORDATA@("TOP",$PIECE($GET(^DIA(100.7,ORIEN,0)),U),ORIEN))

 +31                       SET ORITM=1+$PIECE($GET(@($PIECE(OROUTPUT,","_ORIEN_")")_")")),U,2)

                           SET ORTEXT=$$PAD^ORUTL(ORITM,3)_ORITM_": "_ORTEXT

 +32                       DO WRAP^ORUTL(ORTEXT,OROUTPUT)

 +33                       SET ORCOUNT=@OROUTPUT

 +34                       SET OROUTPUT=$PIECE(OROUTPUT,","_ORIEN_")")_")"

                           SET $PIECE(@OROUTPUT,U)=ORCOUNT+$GET(@OROUTPUT)

                           SET $PIECE(@OROUTPUT,U,2)=1+$PIECE($GET(@OROUTPUT),U,2)

 +35                       IF ORFIELD'=.02

                               SET $PIECE(@OROUTPUT,U,3)=ORNAME(1)

                       End DoDot:2

               End DoDot:1

 +36       SET STOP=$$HEADER^ORUTL("LOGICAL ACCESS CONTROL AUDIT REPORT",.PGNUM)

 +37       if STOP

               QUIT 

 +38       SET ORSITE(1)=$ORDER(^ORD(100.7,0))

           SET ORSITE=$$GET1^DIQ(100.7,ORSITE(1)_",",.01)

 +39       IF ORSITE=""

               SET ORSITE=$PIECE(@ORDATA@("TOP",ORSITE(1)),U,3)

 +40       WRITE "SITE: "_ORSITE

 +41       SET ORDIEN=0

           FOR 

               SET ORDIEN=$ORDER(@ORDATA@("TOP",ORSITE(1),ORDIEN))

               if ORDIEN=""!(STOP)

                   QUIT 

               Begin DoDot:1