PXDELENC ;BAY/RJV-CLEAN UP ENCOUNTERS POINTING TO VISITS THAT DO NOT EXIST. ;14-JUN-2005
;;1.0;PCE;**153**;14-JUL-2004
EN ;Entry Point.
N DIR,DA,ZTRTN,ZTDESC,PXOPT,ZTSK,ZTQUEUED,ZTIO,POP
S DIR("?")="Please enter 1, 2, 3, or 4."
S DIR("?",1)="Please note: Options 1 -3 work directly from the temporary"
S DIR("?",2)="file created by date range under Option 1 - BUILD."
S DIR("?",3)="While Option 4 works with the individual patient selected."
S DIR("?",4)="Option 4 may show different results than the Build Report"
S DIR("?",5)="displays all existing problem encounters by patient."
S DIR("?",6)=""
S DIR(0)="SO^1:BUILD;2:REPORT;3:FIX ALL BUILD ERRORS;4:FIX INDIVIDUAL"
S DIR("L",1)="Select one of the following:"
S DIR("L",2)=""
S DIR("L",3)="1 Build 2 Report 3 Fix All Build Errors 4 Fix Individual"
D ^DIR
S PXOPT=Y
Q:PXOPT=""
K DIR,DA Q:$D(DIRUT)
I PXOPT=1 D ASKBLD
I PXOPT=2 D PRINT
I PXOPT=3 D FIXALL^PXDELFIX
I PXOPT=4 D FIXIND^PXDELFIX
Q
ASKBLD ;
N PXPAT,PXSDATE,PXENC,PXVISIT,PXPRIM,PXSTART,PXEND,PXCOUNT,PXSEC,PXPRI
N PXSDT,PXEDT,PXRANGE,PXREM,Y,%,DIRUT,PXPURGE,PXCREATE,X1,X2,PXATYP
D NOW^%DTC S (PXCREATE,X1)=%,X2=120 D C^%DTC S PXPURGE=X
S ^XTMP("PXDELENC",0)=PXPURGE_"^"_PXCREATE
S Y=$G(^XTMP("PXDELENC","START BUILD")) D DD^%DT S PXSTART=Y
S Y=$G(^XTMP("PXDELENC","END BUILD")) D DD^%DT S PXEND=Y
I PXEND="RUNNING" D Q
.W !!,"Build started on ",PXSTART," still running!"
.D WAIT
S PXSDT=$P($G(^XTMP("PXDELENC","PXENC",0)),"^",1)
S PXEDT=$P($G(^XTMP("PXDELENC","PXENC",0)),"^",2)
S Y=PXSDT D DD^%DT S PXSDT=Y
S Y=PXEDT D DD^%DT S PXEDT=Y
S PXREM=$G(^XTMP("PXDELENC","PXENC","PXCOUNT"))
I PXEND'="" D
.W !!,"Last Build completed on ",PXEND
.W !,"using a date range of ",PXSDT," thru ",PXEDT
.I PXREM>0 W !!,"This build contains ",PXREM," items to be fixed.",!
.I PXREM=0 W !!,"There are 0 remaining items to be fixed.",!
S DIR("A")="Do you wish to continue with NEW Build? "
S DIR(0)="Y",DIR("B")="NO"
D ^DIR
K DA,DIR Q:$D(DIRUT)
I Y=0 Q
ASKBDT ;
S %DT="AEPX",%DT("A")="Enter Begin date for build: "
D ^%DT S PXSDT=Y
I X="^" Q
I Y=-1 W !!,"Invalid Date!",! G ASKBDT
K %DT,Y
ASKEDT ;
S %DT="AEPX",%DT("A")="Enter Ending date for build: "
D ^%DT S PXEDT=Y
I X="^" Q
I Y=-1 W !!,"Invalid Date!",! G ASKEDT
K %DT,Y
K ^XTMP("PXDELENC","PXENC")
S $P(^XTMP("PXDELENC","PXENC",0),"^",1)=PXSDT
S $P(^XTMP("PXDELENC","PXENC",0),"^",2)=PXEDT
D CLEAR^VALM1
S ZTRTN="BUILD^PXDELENC"
S ZTDESC="UTILITY TO LOOK FOR MISSING VISITS"
S ZTSAVE("PX*")="",ZTSAVE("XM*")="",ZTIO=""
D ^%ZTLOAD
I $D(ZTSK) W !,"Request Queued!"
D WAIT
Q
BUILD ; Build missing visits enconters.
S PXPAT="",PXENC="",PXATYP=""
D NOW^%DTC S PXSTART=%
S ^XTMP("PXDELENC","START BUILD")=PXSTART
S ^XTMP("PXDELENC","END BUILD")="RUNNING"
S ^XTMP("PXDELENC",0)=$$FMADD^XLFDT(PXSTART,60)_"^"_PXSTART
S PXSDATE=PXSDT
F S PXSDATE=$O(^SCE("B",PXSDATE)) Q:PXSDATE=""!($P(PXSDATE,".")>PXEDT) D
.F S PXENC=$O(^SCE("B",PXSDATE,PXENC)) Q:PXENC="" D
..S PXPAT=$P($G(^SCE(PXENC,0)),"^",2)
..I $G(PXPAT)="" Q
..S PXATYP=$P($G(^DPT(PXPAT,"S",PXSDATE,0)),"^",2)
..I PXATYP["C" Q
..S PXVISIT=$P($G(^SCE(PXENC,0)),"^",5)
..S PXPRIM=$P($G(^SCE(PXENC,0)),"^",6)
..S PXSEC="" I $P($G(^SCE(PXENC+1,0)),"^",6)=PXENC S PXSEC=PXENC+1
..I $G(PXVISIT)'="" Q
..I $G(PXVISIT)="",$G(PXPRIM)'="" Q
..I $G(PXVISIT)="",$D(^DPT(PXPAT,"S",PXSDATE,0)) D
...S ^XTMP("PXDELENC","PXENC",PXPAT,PXSDATE,PXENC)=$G(PXSEC)
D NOW^%DTC S PXEND=%
S ^XTMP("PXDELENC","PXENC","PXCOUNT")=$$COUNT()
S ^XTMP("PXDELENC","END BUILD")=PXEND
D PXMAIL
Q
PRINT ; Print report of missing visits.
N PXPAT,PXENC,PXSDATE,PXPATNM,PXNUMNM,%ZIS,PXSDTE,PXEND,PXPAGE
N PXPRIM,PXPRIX,PXWARN
S PXPAT=0,PXSDATE="",PXENC="",PXEND="",PXPAGE=0,PXWARN=0
I $G(^XTMP("PXDELENC","END BUILD"))="RUNNING" D Q
.W !!,"Build is running, please wait until complete!"
.D WAIT
I $G(^XTMP("PXDELENC","PXENC","PXCOUNT"))=0 D Q
.W !!,"No missing visits found!"
.D WAIT
S %ZIS="Q" D ^%ZIS
I POP Q
I $G(IO("Q"))=1 D Q
.N ZTRTN,ZTDESC,ZTSAVE
.S ZTRTN="PRINT1^PXDELENC",ZTDESC="MISSING VISIT REPORT"
.S ZTSAVE("PX*")=""
.D ^%ZTLOAD K IO("Q")
PRINT1 ;
U IO
D HDR
F S PXPAT=$O(^XTMP("PXDELENC","PXENC",PXPAT)) Q:PXPAT=""!(PXEND) D
.F S PXSDATE=$O(^XTMP("PXDELENC","PXENC",PXPAT,PXSDATE)) Q:PXSDATE=""!(PXEND) D
..F S PXENC=$O(^XTMP("PXDELENC","PXENC",PXPAT,PXSDATE,PXENC)) Q:PXENC=""!(PXEND) D
...S PXPRIX=""
...S PXSDTE=PXSDATE
...S Y=PXSDTE D DD^%DT S PXSDTE=Y
...S PXPATNM=$P($G(^DPT(PXPAT,0)),"^",1)
...S PXNUMNM=PXPAT_" - "_PXPATNM
...S PXSEC=$G(^XTMP("PXDELENC","PXENC",PXPAT,PXSDATE,PXENC))
...I '$D(^SCE(PXENC)),$G(PXSEC)'="" S PXPRIX="*",PXWARN=1
...W !,?2,$E(PXNUMNM,1,32),?35,PXSDTE,?55,PXENC,?65,$G(PXSEC)_PXPRIX
...D HDR:$Y+3>IOSL Q:PXEND
I PXWARN D
.W !!,?15,"* Secondary Encounter exists without Primary!"
.W !,?15,"Please note: Secondary Encounters can only be corrected"
.W !,?15,"by the FIX ALL option as the FIX INDIVIDUAL option requires"
.W !,?15,"the Primary Encounter to exist."
D:'PXEND WAIT
W @IOF
D ^%ZISC
Q
HDR ;
N PXSDT,PXEDT
S PXSDT=$P($G(^XTMP("PXDELENC","PXENC",0)),"^",1)
S PXEDT=$P($G(^XTMP("PXDELENC","PXENC",0)),"^",2)
S Y=PXSDT D DD^%DT S PXSDT=Y
S Y=PXEDT D DD^%DT S PXEDT=Y
I PXPAGE>0,$E(IOST,1,2)="C-" S PXEND=$$EOP() Q:PXEND
S PXPAGE=PXPAGE+1
W:PXPAGE'=1 @IOF
W !!,"Missing Visit Report for Date Range of ",$G(PXSDT)_" - "_$G(PXEDT),!!
W !,?2,"Patient IEN - Name",?35,"Appt Date",?55,"Prim Enc",?65,"2nd Enc"
W !,?2,"==================",?35,"=========",?55,"========",?65,"======="
Q
EOP() ; End of page check
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
I $E(IOST,1,2)'="C-" Q 0 ;NOT TERMINAL
S DIR(0)="E"
D ^DIR
Q 'Y
PXMAIL ;Send mail message when build complete.
N XMAIL,XMSUB,XMDUZ,XMTEXT,PXTEXT,Y,XMY,XMMG,XMZ
S Y=$G(PXSTART) D DD^%DT S PXSTART=Y
S Y=$G(PXEND) D DD^%DT S PXEND=Y
S Y=$G(PXSDT) D DD^%DT S PXSDT=Y
S Y=$G(PXEDT) D DD^%DT S PXEDT=Y
S ZTQUEUED=1
S PXTEXT(1)="PCE DELETE ENCOUNTER W/O VISIT is ready to report & fix."
S PXTEXT(2)="Build (PXDELENC) for range of "_$G(PXSDT)_"-"_$G(PXEDT)_" has completed"
S PXTEXT(3)="Start time: "_$G(PXSTART)_" End time: "_$G(PXEND)
S XMSUB="PCE Delete Encounters W/O Visit...Build Completed.."
S XMTEXT="PXTEXT(",XMDUZ=.5,XMY(DUZ)=""
D ^XMD
S ^XTMP("PXDELENC","PXENC","PXMAIL")=$G(XMZ)_"^"_DUZ_"^"_$G(XMMG)
K XMSUB,XMTEXT,XMY
Q
WAIT ;
Q:IO'=$G(IO("HOME"))
N DIR,X,Y,DIRUT,DUOUT,DTOUT,DIROUT
W ! S DIR(0)="E" S DIR("A")="Enter RETURN to continue" D ^DIR W !
Q
COUNT() ;
N PXCOUNT,PXPAT,PXSDATE,PXENC
S PXCOUNT=0,PXPAT="",PXSDATE="",PXENC=""
F S PXPAT=$O(^XTMP("PXDELENC","PXENC",PXPAT)) Q:PXPAT="" D
.F S PXSDATE=$O(^XTMP("PXDELENC","PXENC",PXPAT,PXSDATE)) Q:PXSDATE="" D
..F S PXENC=$O(^XTMP("PXDELENC","PXENC",PXPAT,PXSDATE,PXENC)) Q:PXENC="" D
...S PXCOUNT=PXCOUNT+1
Q PXCOUNT
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXDELENC 7022 printed Oct 16, 2024@18:29:14 Page 2
PXDELENC ;BAY/RJV-CLEAN UP ENCOUNTERS POINTING TO VISITS THAT DO NOT EXIST. ;14-JUN-2005
+1 ;;1.0;PCE;**153**;14-JUL-2004
EN ;Entry Point.
+1 NEW DIR,DA,ZTRTN,ZTDESC,PXOPT,ZTSK,ZTQUEUED,ZTIO,POP
+2 SET DIR("?")="Please enter 1, 2, 3, or 4."
+3 SET DIR("?",1)="Please note: Options 1 -3 work directly from the temporary"
+4 SET DIR("?",2)="file created by date range under Option 1 - BUILD."
+5 SET DIR("?",3)="While Option 4 works with the individual patient selected."
+6 SET DIR("?",4)="Option 4 may show different results than the Build Report"
+7 SET DIR("?",5)="displays all existing problem encounters by patient."
+8 SET DIR("?",6)=""
+9 SET DIR(0)="SO^1:BUILD;2:REPORT;3:FIX ALL BUILD ERRORS;4:FIX INDIVIDUAL"
+10 SET DIR("L",1)="Select one of the following:"
+11 SET DIR("L",2)=""
+12 SET DIR("L",3)="1 Build 2 Report 3 Fix All Build Errors 4 Fix Individual"
+13 DO ^DIR
+14 SET PXOPT=Y
+15 if PXOPT=""
QUIT
+16 KILL DIR,DA
if $DATA(DIRUT)
QUIT
+17 IF PXOPT=1
DO ASKBLD
+18 IF PXOPT=2
DO PRINT
+19 IF PXOPT=3
DO FIXALL^PXDELFIX
+20 IF PXOPT=4
DO FIXIND^PXDELFIX
+21 QUIT
ASKBLD ;
+1 NEW PXPAT,PXSDATE,PXENC,PXVISIT,PXPRIM,PXSTART,PXEND,PXCOUNT,PXSEC,PXPRI
+2 NEW PXSDT,PXEDT,PXRANGE,PXREM,Y,%,DIRUT,PXPURGE,PXCREATE,X1,X2,PXATYP
+3 DO NOW^%DTC
SET (PXCREATE,X1)=%
SET X2=120
DO C^%DTC
SET PXPURGE=X
+4 SET ^XTMP("PXDELENC",0)=PXPURGE_"^"_PXCREATE
+5 SET Y=$GET(^XTMP("PXDELENC","START BUILD"))
DO DD^%DT
SET PXSTART=Y
+6 SET Y=$GET(^XTMP("PXDELENC","END BUILD"))
DO DD^%DT
SET PXEND=Y
+7 IF PXEND="RUNNING"
Begin DoDot:1
+8 WRITE !!,"Build started on ",PXSTART," still running!"
+9 DO WAIT
End DoDot:1
QUIT
+10 SET PXSDT=$PIECE($GET(^XTMP("PXDELENC","PXENC",0)),"^",1)
+11 SET PXEDT=$PIECE($GET(^XTMP("PXDELENC","PXENC",0)),"^",2)
+12 SET Y=PXSDT
DO DD^%DT
SET PXSDT=Y
+13 SET Y=PXEDT
DO DD^%DT
SET PXEDT=Y
+14 SET PXREM=$GET(^XTMP("PXDELENC","PXENC","PXCOUNT"))
+15 IF PXEND'=""
Begin DoDot:1
+16 WRITE !!,"Last Build completed on ",PXEND
+17 WRITE !,"using a date range of ",PXSDT," thru ",PXEDT
+18 IF PXREM>0
WRITE !!,"This build contains ",PXREM," items to be fixed.",!
+19 IF PXREM=0
WRITE !!,"There are 0 remaining items to be fixed.",!
End DoDot:1
+20 SET DIR("A")="Do you wish to continue with NEW Build? "
+21 SET DIR(0)="Y"
SET DIR("B")="NO"
+22 DO ^DIR
+23 KILL DA,DIR
if $DATA(DIRUT)
QUIT
+24 IF Y=0
QUIT
ASKBDT ;
+1 SET %DT="AEPX"
SET %DT("A")="Enter Begin date for build: "
+2 DO ^%DT
SET PXSDT=Y
+3 IF X="^"
QUIT
+4 IF Y=-1
WRITE !!,"Invalid Date!",!
GOTO ASKBDT
+5 KILL %DT,Y
ASKEDT ;
+1 SET %DT="AEPX"
SET %DT("A")="Enter Ending date for build: "
+2 DO ^%DT
SET PXEDT=Y
+3 IF X="^"
QUIT
+4 IF Y=-1
WRITE !!,"Invalid Date!",!
GOTO ASKEDT
+5 KILL %DT,Y
+6 KILL ^XTMP("PXDELENC","PXENC")
+7 SET $PIECE(^XTMP("PXDELENC","PXENC",0),"^",1)=PXSDT
+8 SET $PIECE(^XTMP("PXDELENC","PXENC",0),"^",2)=PXEDT
+9 DO CLEAR^VALM1
+10 SET ZTRTN="BUILD^PXDELENC"
+11 SET ZTDESC="UTILITY TO LOOK FOR MISSING VISITS"
+12 SET ZTSAVE("PX*")=""
SET ZTSAVE("XM*")=""
SET ZTIO=""
+13 DO ^%ZTLOAD
+14 IF $DATA(ZTSK)
WRITE !,"Request Queued!"
+15 DO WAIT
+16 QUIT
BUILD ; Build missing visits enconters.
+1 SET PXPAT=""
SET PXENC=""
SET PXATYP=""
+2 DO NOW^%DTC
SET PXSTART=%
+3 SET ^XTMP("PXDELENC","START BUILD")=PXSTART
+4 SET ^XTMP("PXDELENC","END BUILD")="RUNNING"
+5 SET ^XTMP("PXDELENC",0)=$$FMADD^XLFDT(PXSTART,60)_"^"_PXSTART
+6 SET PXSDATE=PXSDT
+7 FOR
SET PXSDATE=$ORDER(^SCE("B",PXSDATE))
if PXSDATE=""!($PIECE(PXSDATE,".")>PXEDT)
QUIT
Begin DoDot:1
+8 FOR
SET PXENC=$ORDER(^SCE("B",PXSDATE,PXENC))
if PXENC=""
QUIT
Begin DoDot:2
+9 SET PXPAT=$PIECE($GET(^SCE(PXENC,0)),"^",2)
+10 IF $GET(PXPAT)=""
QUIT
+11 SET PXATYP=$PIECE($GET(^DPT(PXPAT,"S",PXSDATE,0)),"^",2)
+12 IF PXATYP["C"
QUIT
+13 SET PXVISIT=$PIECE($GET(^SCE(PXENC,0)),"^",5)
+14 SET PXPRIM=$PIECE($GET(^SCE(PXENC,0)),"^",6)
+15 SET PXSEC=""
IF $PIECE($GET(^SCE(PXENC+1,0)),"^",6)=PXENC
SET PXSEC=PXENC+1
+16 IF $GET(PXVISIT)'=""
QUIT
+17 IF $GET(PXVISIT)=""
IF $GET(PXPRIM)'=""
QUIT
+18 IF $GET(PXVISIT)=""
IF $DATA(^DPT(PXPAT,"S",PXSDATE,0))
Begin DoDot:3
+19 SET ^XTMP("PXDELENC","PXENC",PXPAT,PXSDATE,PXENC)=$GET(PXSEC)
End DoDot:3
End DoDot:2
End DoDot:1
+20 DO NOW^%DTC
SET PXEND=%
+21 SET ^XTMP("PXDELENC","PXENC","PXCOUNT")=$$COUNT()
+22 SET ^XTMP("PXDELENC","END BUILD")=PXEND
+23 DO PXMAIL
+24 QUIT
PRINT ; Print report of missing visits.
+1 NEW PXPAT,PXENC,PXSDATE,PXPATNM,PXNUMNM,%ZIS,PXSDTE,PXEND,PXPAGE
+2 NEW PXPRIM,PXPRIX,PXWARN
+3 SET PXPAT=0
SET PXSDATE=""
SET PXENC=""
SET PXEND=""
SET PXPAGE=0
SET PXWARN=0
+4 IF $GET(^XTMP("PXDELENC","END BUILD"))="RUNNING"
Begin DoDot:1
+5 WRITE !!,"Build is running, please wait until complete!"
+6 DO WAIT
End DoDot:1
QUIT
+7 IF $GET(^XTMP("PXDELENC","PXENC","PXCOUNT"))=0
Begin DoDot:1
+8 WRITE !!,"No missing visits found!"
+9 DO WAIT
End DoDot:1
QUIT
+10 SET %ZIS="Q"
DO ^%ZIS
+11 IF POP
QUIT
+12 IF $GET(IO("Q"))=1
Begin DoDot:1
+13 NEW ZTRTN,ZTDESC,ZTSAVE
+14 SET ZTRTN="PRINT1^PXDELENC"
SET ZTDESC="MISSING VISIT REPORT"
+15 SET ZTSAVE("PX*")=""
+16 DO ^%ZTLOAD
KILL IO("Q")
End DoDot:1
QUIT
PRINT1 ;
+1 USE IO
+2 DO HDR
+3 FOR
SET PXPAT=$ORDER(^XTMP("PXDELENC","PXENC",PXPAT))
if PXPAT=""!(PXEND)
QUIT
Begin DoDot:1
+4 FOR
SET PXSDATE=$ORDER(^XTMP("PXDELENC","PXENC",PXPAT,PXSDATE))
if PXSDATE=""!(PXEND)
QUIT
Begin DoDot:2
+5 FOR
SET PXENC=$ORDER(^XTMP("PXDELENC","PXENC",PXPAT,PXSDATE,PXENC))
if PXENC=""!(PXEND)
QUIT
Begin DoDot:3
+6 SET PXPRIX=""
+7 SET PXSDTE=PXSDATE
+8 SET Y=PXSDTE
DO DD^%DT
SET PXSDTE=Y
+9 SET PXPATNM=$PIECE($GET(^DPT(PXPAT,0)),"^",1)
+10 SET PXNUMNM=PXPAT_" - "_PXPATNM
+11 SET PXSEC=$GET(^XTMP("PXDELENC","PXENC",PXPAT,PXSDATE,PXENC))
+12 IF '$DATA(^SCE(PXENC))
IF $GET(PXSEC)'=""
SET PXPRIX="*"
SET PXWARN=1
+13 WRITE !,?2,$EXTRACT(PXNUMNM,1,32),?35,PXSDTE,?55,PXENC,?65,$GET(PXSEC)_PXPRIX
+14 if $Y+3>IOSL
DO HDR
if PXEND
QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+15 IF PXWARN
Begin DoDot:1
+16 WRITE !!,?15,"* Secondary Encounter exists without Primary!"
+17 WRITE !,?15,"Please note: Secondary Encounters can only be corrected"
+18 WRITE !,?15,"by the FIX ALL option as the FIX INDIVIDUAL option requires"
+19 WRITE !,?15,"the Primary Encounter to exist."
End DoDot:1
+20 if 'PXEND
DO WAIT
+21 WRITE @IOF
+22 DO ^%ZISC
+23 QUIT
HDR ;
+1 NEW PXSDT,PXEDT
+2 SET PXSDT=$PIECE($GET(^XTMP("PXDELENC","PXENC",0)),"^",1)
+3 SET PXEDT=$PIECE($GET(^XTMP("PXDELENC","PXENC",0)),"^",2)
+4 SET Y=PXSDT
DO DD^%DT
SET PXSDT=Y
+5 SET Y=PXEDT
DO DD^%DT
SET PXEDT=Y
+6 IF PXPAGE>0
IF $EXTRACT(IOST,1,2)="C-"
SET PXEND=$$EOP()
if PXEND
QUIT
+7 SET PXPAGE=PXPAGE+1
+8 if PXPAGE'=1
WRITE @IOF
+9 WRITE !!,"Missing Visit Report for Date Range of ",$GET(PXSDT)_" - "_$GET(PXEDT),!!
+10 WRITE !,?2,"Patient IEN - Name",?35,"Appt Date",?55,"Prim Enc",?65,"2nd Enc"
+11 WRITE !,?2,"==================",?35,"=========",?55,"========",?65,"======="
+12 QUIT
EOP() ; End of page check
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+2 ;NOT TERMINAL
IF $EXTRACT(IOST,1,2)'="C-"
QUIT 0
+3 SET DIR(0)="E"
+4 DO ^DIR
+5 QUIT 'Y
PXMAIL ;Send mail message when build complete.
+1 NEW XMAIL,XMSUB,XMDUZ,XMTEXT,PXTEXT,Y,XMY,XMMG,XMZ
+2 SET Y=$GET(PXSTART)
DO DD^%DT
SET PXSTART=Y
+3 SET Y=$GET(PXEND)
DO DD^%DT
SET PXEND=Y
+4 SET Y=$GET(PXSDT)
DO DD^%DT
SET PXSDT=Y
+5 SET Y=$GET(PXEDT)
DO DD^%DT
SET PXEDT=Y
+6 SET ZTQUEUED=1
+7 SET PXTEXT(1)="PCE DELETE ENCOUNTER W/O VISIT is ready to report & fix."
+8 SET PXTEXT(2)="Build (PXDELENC) for range of "_$GET(PXSDT)_"-"_$GET(PXEDT)_" has completed"
+9 SET PXTEXT(3)="Start time: "_$GET(PXSTART)_" End time: "_$GET(PXEND)
+10 SET XMSUB="PCE Delete Encounters W/O Visit...Build Completed.."
+11 SET XMTEXT="PXTEXT("
SET XMDUZ=.5
SET XMY(DUZ)=""
+12 DO ^XMD
+13 SET ^XTMP("PXDELENC","PXENC","PXMAIL")=$GET(XMZ)_"^"_DUZ_"^"_$GET(XMMG)
+14 KILL XMSUB,XMTEXT,XMY
+15 QUIT
WAIT ;
+1 if IO'=$GET(IO("HOME"))
QUIT
+2 NEW DIR,X,Y,DIRUT,DUOUT,DTOUT,DIROUT
+3 WRITE !
SET DIR(0)="E"
SET DIR("A")="Enter RETURN to continue"
DO ^DIR
WRITE !
+4 QUIT
COUNT() ;
+1 NEW PXCOUNT,PXPAT,PXSDATE,PXENC
+2 SET PXCOUNT=0
SET PXPAT=""
SET PXSDATE=""
SET PXENC=""
+3 FOR
SET PXPAT=$ORDER(^XTMP("PXDELENC","PXENC",PXPAT))
if PXPAT=""
QUIT
Begin DoDot:1
+4 FOR
SET PXSDATE=$ORDER(^XTMP("PXDELENC","PXENC",PXPAT,PXSDATE))
if PXSDATE=""
QUIT
Begin DoDot:2
+5 FOR
SET PXENC=$ORDER(^XTMP("PXDELENC","PXENC",PXPAT,PXSDATE,PXENC))
if PXENC=""
QUIT
Begin DoDot:3
+6 SET PXCOUNT=PXCOUNT+1
End DoDot:3
End DoDot:2
End DoDot:1
+7 QUIT PXCOUNT
+8 ;
