- 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 Jan 18, 2025@03:29: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 ;