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 ---[H[J[2J[HORDEA01B 13238 printed Dec 13, 2024@02:29:56 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
+42 NEW ORLINE
+43 SET ORLINE=0
FOR
SET ORLINE=$ORDER(@ORDATA@("TOP",ORSITE(1),ORDIEN,ORLINE))
if ORLINE=""!(STOP)
QUIT
Begin DoDot:2
+44 IF ($Y+CBUFFER+1)>IOSL
Begin DoDot:3
+45 SET STOP=$$HEADER^ORUTL("LOGICAL ACCESS CONTROL AUDIT REPORT",.PGNUM)
End DoDot:3
if STOP
QUIT
+46 WRITE !,@ORDATA@("TOP",ORSITE(1),ORDIEN,ORLINE)
End DoDot:2
End DoDot:1
+47 if STOP
QUIT
+48 SET ORDIVISION=""
FOR
SET ORDIVISION=$ORDER(@ORDATA@(ORDIVISION))
if ORDIVISION=""!(STOP)
QUIT
Begin DoDot:1
+49 if ORDIVISION="TOP"
QUIT
+50 IF ($Y+CBUFFER+2)>IOSL
Begin DoDot:2
+51 SET STOP=$$HEADER^ORUTL("LOGICAL ACCESS CONTROL AUDIT REPORT",.PGNUM)
End DoDot:2
if STOP
QUIT
+52 WRITE !!,"DIVISION: "_ORDIVISION
+53 SET ORDUZ=0
FOR
SET ORDUZ=$ORDER(@ORDATA@(ORDIVISION,ORDUZ))
if ORDUZ=""!(STOP)
QUIT
Begin DoDot:2
+54 IF ($Y+CBUFFER+@ORDATA@(ORDIVISION,ORDUZ))>IOSL
Begin DoDot:3
+55 SET STOP=$$HEADER^ORUTL("LOGICAL ACCESS CONTROL AUDIT REPORT",.PGNUM)
End DoDot:3
if STOP
QUIT
+56 NEW ORDIEN,ORUSER
+57 SET ORUSER=$$GET1^DIQ(200,ORDUZ_",",.01)
+58 if ORUSER=""
SET ORUSER=$PIECE(@ORDATA@(ORDIVISION,ORDUZ),U,3)
+59 WRITE !,"USER: "_ORUSER
+60 SET ORDIEN=0
FOR
SET ORDIEN=$ORDER(@ORDATA@(ORDIVISION,ORDUZ,ORDIEN))
if ORDIEN=""
QUIT
Begin DoDot:3
+61 NEW ORLINE
+62 SET ORLINE=0
FOR
SET ORLINE=$ORDER(@ORDATA@(ORDIVISION,ORDUZ,ORDIEN,ORLINE))
if ORLINE=""
QUIT
Begin DoDot:4
+63 WRITE !,@ORDATA@(ORDIVISION,ORDUZ,ORDIEN,ORLINE)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+64 KILL @ORDATA
+65 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+66 QUIT
LAST ;List those providers that contain a space and/or punctuation in the last name
+1 ;REP IS HANDLED BY REPORTS^ORDEA01
+2 WRITE !!,"This report identifies providers with one or more space or punctuation",!
+3 WRITE "characters in their family (last) name. These providers may not be able to",!
+4 WRITE "link their PIV card using CPRS GUI. For these providers, someone may have",!
+5 WRITE "to use the Data Entry for e-Prescribing Controlled Substances GUI and",!
+6 WRITE "manually enter the subject alternative name stored on the provider's PIV",!
+7 WRITE "card.",!!
+8 WRITE "Additionally, it is recommended that for those providers who's NAME COMPONENTS",!
+9 WRITE "file (#20) entry does not exactly match the value in the NAME field (#.01) in",!
+10 WRITE "the NEW PERSON file (#200), either the NAME COMPONENTS file entry or the value",!
+11 WRITE "in the NAME field in the NEW PERSON file are modified so that both are the same.",!
+12 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,DISINC,DIV,SCREEN2,SAVE
+13 SET DISINC=$$DISPRMPT^ORDEA01()
+14 if DISINC=U
QUIT
+15 WRITE !
+16 SET DIR(0)="Y"_U
+17 SET DIR("A",1)="Do you want to include providers who have already linked their PIV card"
+18 SET DIR("A")="with their VistA account"
+19 SET DIR("B")="NO"
+20 DO ^DIR
+21 if $DATA(DIRUT)
QUIT
+22 IF 'Y
SET SCREEN2="I $$GET1^DIQ(200,Y_"","",501.2)="""""
+23 SET X=$$DIVPRMPT^ORUTL(.DIV)
+24 if X<1
QUIT
+25 SET SAVE("DISINC")=""
SET SAVE("DIV(")=""
+26 if $DATA(SCREEN2)
SET SAVE("SCREEN2")=""
+27 DO DEVICE^ORUTL($PIECE(REP(REP),";",3),"OR "_$$UP^XLFSTR($PIECE(REP(REP),";")),"Q",.SAVE)
+28 QUIT
LASTQ ;TASKMAN ENTRY POINT
+1 ;CBUFFER IS HANDLED BY DEVICE^ORUTL OR TASKMAN
+2 NEW Y,OUT,DATA,REASON,PGNUM,COL,STOP,OUTPUT,DHEADER
+3 SET DATA=$NAME(^TMP($JOB,"ORLASTMP"))
KILL @DATA
+4 SET COL(2)=$$LJ^XLFSTR("PROVIDER NAME",37," ")_"ACCOUNT STATUS"
+5 SET REASON="THE NAME COMPONENTS FILE (#20) ENTRY DOES NOT MATCH THE NAME FIELD (#.01) IN THE "
+6 SET REASON=REASON_"NEW PERSON FILE (#200)."
+7 ;IA #10076
+8 SET Y=0
FOR
SET Y=$ORDER(^XUSEC("ORES",Y))
if +$GET(Y)=0
QUIT
Begin DoDot:1
+9 NEW STATUS
SET STATUS=$$ACTIVE^XUSER(Y)
+10 IF 'DISINC
IF (+STATUS<1)
IF ($PIECE(STATUS,U,2)'="")
QUIT
+11 ;INCLUDE USERS WHO CANNOT SIGN-ON IN ACTIVE LISTING
+12 SET STATUS("TEXT")=$SELECT($PIECE(STATUS,U,2)'="":$PIECE(STATUS,U,2),STATUS=0:"CANNOT SIGN ON",1:"UNKNOWN")
+13 IF STATUS=0
SET STATUS=1
+14 NEW DIVISION
SET DIVISION=$$HASDIV^ORUTL(Y,.DIV)
+15 if DIVISION=""
QUIT
+16 IF $DATA(SCREEN2)
XECUTE SCREEN2
IF '$TEST
QUIT
+17 NEW ONAME,CNAME,ITEM
+18 SET ONAME=$$GET1^DIQ(200,Y_",",.01)
+19 DO NAMECOMP^XLFNAME(.ONAME)
+20 SET ONAME("STRIPPED")=$$STRIP^ORDEA01A(ONAME("FAMILY"))
+21 SET CNAME("FILE")=200
SET CNAME("FIELD")=.01
SET CNAME("IENS")=Y_","
+22 SET CNAME=$$NAMEFMT^XLFNAME(.CNAME,"F","C")
+23 DO NAMECOMP^XLFNAME(.CNAME)
+24 SET CNAME("STRIPPED")=$$STRIP^ORDEA01A(CNAME("FAMILY"))
+25 IF ONAME("FAMILY")'=ONAME("STRIPPED")
SET @DATA@(DIVISION,+STATUS,ONAME)=STATUS("TEXT")
+26 IF ONAME("FAMILY")=ONAME("STRIPPED")&(CNAME("FAMILY")'=CNAME("STRIPPED"))
Begin DoDot:2
+27 SET @DATA@(DIVISION,+STATUS,ONAME)=STATUS("TEXT")
+28 SET @DATA@(DIVISION,+STATUS,ONAME,CNAME)=""
End DoDot:2
+29 FOR ITEM="FAMILY","GIVEN","MIDDLE","SUFFIX"
Begin DoDot:2
+30 IF ONAME(ITEM)'=CNAME(ITEM)
Begin DoDot:3
+31 SET @DATA@(DIVISION,+STATUS,ONAME)=STATUS("TEXT")
+32 SET @DATA@(DIVISION,+STATUS,ONAME,CNAME)=REASON
End DoDot:3
End DoDot:2
End DoDot:1
+33 NEW DIVISION
SET DIVISION=""
FOR
SET DIVISION=$ORDER(@DATA@(DIVISION))
if $GET(DIVISION)=""!($GET(STOP))
QUIT
Begin DoDot:1
+34 SET COL(1)="DIVISION: "_DIVISION
+35 SET STOP=$$HEADER^ORUTL("PROVIDER LAST NAME REPORT",.PGNUM,.COL)
+36 if STOP
QUIT
+37 SET DHEADER=0
+38 NEW STATUS
FOR STATUS=1:-1:0
Begin DoDot:2
+39 NEW NAME
SET NAME=""
FOR
SET NAME=$ORDER(@DATA@(DIVISION,STATUS,NAME))
if $GET(NAME)=""!(STOP)
QUIT
Begin DoDot:3
+40 NEW NAMEC,OUT
SET NAMEC=""
FOR
SET NAMEC=$ORDER(@DATA@(DIVISION,STATUS,NAME,NAMEC))
if $GET(NAMEC)=""!(STOP)
QUIT
Begin DoDot:4
+41 DO WRAP^ORUTL(" NAME COMPONENTS: "_NAMEC,"OUT")
SET OUT=OUT+1
+42 IF $GET(@DATA@(DIVISION,STATUS,NAME,NAMEC))'=""
DO WRAP^ORUTL(" "_@DATA@(DIVISION,STATUS,NAME,NAMEC),"OUT")
End DoDot:4
+43 IF ($Y+$GET(OUT)+CBUFFER+$SELECT(STATUS=0&('DHEADER):3,1:0))>IOSL
Begin DoDot:4
+44 SET STOP=$$HEADER^ORUTL("PROVIDER LAST NAME REPORT",.PGNUM,.COL)
End DoDot:4
if STOP
QUIT
+45 IF STATUS=0
IF ('DHEADER)
Begin DoDot:4
+46 if $Y>4
WRITE !
+47 WRITE $$CJ^XLFSTR("*** DISUSERED/TERMINATED USERS ***",$SELECT(+$GET(IOM)>0:(IOM-1),1:79)," "),!
+48 WRITE $$CJ^XLFSTR($$REPEAT^XLFSTR("-",34),$SELECT(+$GET(IOM)>0:(IOM-1),1:79)," "),!
+49 SET DHEADER=1
End DoDot:4
+50 WRITE $$LJ^XLFSTR(NAME,37," ")_@DATA@(DIVISION,STATUS,NAME),!
+51 SET OUT=0
FOR
SET OUT=$ORDER(OUT(OUT))
if 'OUT
QUIT
WRITE OUT(OUT)
IF ($Y+1)<IOSL
WRITE !
+52 SET OUTPUT=1
End DoDot:3
End DoDot:2
if STOP
QUIT
End DoDot:1
+53 IF '$GET(STOP)
Begin DoDot:1
+54 IF '$GET(OUTPUT)
Begin DoDot:2
+55 SET STOP=$$HEADER^ORUTL("PROVIDER LAST NAME REPORT",.PGNUM,.COL)
+56 if STOP
QUIT
+57 WRITE !,$$CJ^XLFSTR("No family (last) name issues found.",$SELECT(+$GET(IOM)>0:(IOM-1),1:79)," "),!
End DoDot:2
if $GET(STOP)
QUIT
+58 IF ($Y+2)>IOSL
SET STOP=$$HEADER^ORUTL("PROVIDER LAST NAME REPORT",.PGNUM,.COL)
+59 if $GET(STOP)
QUIT
+60 WRITE !,$$CJ^XLFSTR("[END OF REPORT]",$SELECT(+$GET(IOM)>0:(IOM-1),1:79)," ")
End DoDot:1
+61 KILL @DATA
+62 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+63 QUIT
