Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXDELENC

PXDELENC.m

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