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  Sep 23, 2025@20:04:38                                                                                                                                                                                                    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       ;