PXICLN1 ;ISL/dee - Cleanup routine for PX*1.0*1 ;9/3/96
;;1.0;PCE PATIENT CARE ENCOUNTER;**1**;Aug 12, 1996
;
D PACKAGE
D QUE
Q
;
PACKAGE ;Fix the PCE package file entry.
N PXPCE,PXPCE,PXPCE22,PXVT,PXVTC,PXVT22,PXFDA,PXERROR
S PXPCE=$$PKG2IEN^VSIT("PX")
S PXPCEC=PXPCE_","
Q:PXPCE'>0
S PXVT=$$PKG2IEN^VSIT("VSIT")
S PXVTC=PXVT_","
D
. N DIC,X,Y
. S DIC="^DIC(9.4,"_PXPCE_",22,"
. S DIC(0)="LX"
. S DIC("P")=$P(^DD(9.4,22,0),"^",2)
. S DA(1)=PXPCE
. S X="1.0"
. D ^DIC
. S PXPCE22=+Y
I $$GET1^DIQ(9.4,PXPCEC,2,"I","","PXERROR")="" D
. S PXFDA(9.4,PXPCEC,2)="Patient Care Encounter"
I $$GET1^DIQ(9.4,PXPCEC,11.01,"I","","PXERROR")="" D
. S PXFDA(9.4,PXPCEC,11.01)="SLC"
I $$GET1^DIQ(9.4,PXPCEC,11.3,"I","","PXERROR")="" D
. S PXFDA(9.4,PXPCEC,11.3)="I"
I $$GET1^DIQ(9.4,PXPCEC,13,"I","","PXERROR")'="1.0" D
. S PXFDA(9.4,PXPCEC,13)="1.0"
I PXVT>0,$G(PXPCE22)>0 D
. D
.. N DIC,X,Y
.. S DIC="^DIC(9.4,"_PXVT_",22,"
.. S DIC(0)="X"
.. S DIC("P")=$P(^DD(9.4,22,0),"^",2)
.. S DA(1)=PXVT
.. S X="2.0"
.. D ^DIC
.. S PXVT22=+Y
. I PXVT22>0 D
.. N PXP22,PXV22
.. S PXP22=PXPCE22_","_PXPCEC
.. S PXV22=PXVT22_","_PXVTC
.. I $$GET1^DIQ(9.49,PXP22,1,"I","","PXERROR")="" D
... S X=$$GET1^DIQ(9.49,PXV22,1,"I","","PXERROR")
... I X]"" S PXFDA(9.49,PXP22,1)=X
.. I $$GET1^DIQ(9.49,PXP22,2,"I","","PXERROR")="" D
... S X=$$GET1^DIQ(9.49,PXV22,2,"I","","PXERROR")
... I X]"" S PXFDA(9.49,PXP22,2)=X
.. I $$GET1^DIQ(9.49,PXP22,3,"I","","PXERROR")="" D
... S X=$$GET1^DIQ(9.49,PXV22,3,"I","","PXERROR")
... I X]"" S PXFDA(9.49,PXP22,3)=X
I $D(PXFDA) D FILE^DIE("","PXFDA")
Q
;
QUE ; Queue job to deleting the 800 node on all Stop Code Visits.
N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK,ZTSAVE
D BMES^XPDUTL("Deleting the 800 node on all Stop Code Visits.")
S ZTRTN="STOP800^PXICLN1"
S ZTIO=""
S ZTDESC="PX*1.0*1 tasked cleanup job"
S ZTDTH=$H
D ^%ZTLOAD
I $D(ZTSK) D MES^XPDUTL("The job is task # "_ZTSK)
I '$D(ZTSK) D MES^XPDUTL("Could not start the task job.") D BMES^XPDUTL("You should start it by doing: D QUE^PXICLN1 at the programmers prompt.")
Q
;
STOP800 ;Delete the 800 node from all Stop Code visits
N PXIVSIT,VSIT
S PXIVSIT=0
F S PXIVSIT=$O(^AUPNVSIT(PXIVSIT)) Q:'PXIVSIT D
. Q:'$D(^AUPNVSIT(PXIVSIT,800))
. Q:$P($G(^AUPNVSIT(PXIVSIT,150)),"^",3)'="S"
. K VSIT
. I $P(^AUPNVSIT(PXIVSIT,800),"^",1)]"" S VSIT("SC")="@"
. I $P(^AUPNVSIT(PXIVSIT,800),"^",2)]"" S VSIT("AO")="@"
. I $P(^AUPNVSIT(PXIVSIT,800),"^",3)]"" S VSIT("IR")="@"
. I $P(^AUPNVSIT(PXIVSIT,800),"^",4)]"" S VSIT("EC")="@"
. I $D(VSIT) S VSIT("IEN")=PXIVSIT D UPD^VSIT K ^AUPNVSIT(PXIVSIT,800)
;
MAIL ;Send mail messge that job is done. Also send to SLC IRMFO.
N XMY,XMSUB,PXTEXT,XMTEXT
S XMY(DUZ)=""
S XMY("G.PCEINSTAL@ISC-SLC.DOMAIN.EXT")=""
S XMSUB="PX*1.0*1 Cleanup is finished"
S PXTEXT(1)="PX*1.0*1 Cleanup job is done."
S:$D(ZTQUEUED) PXTEXT(2)="The task job number "_ZTQUEUED_" is finished."
S PXTEXT(3)=" "
S PXTEXT(4)="The site part if the Visit ID for this site is:"
S PXTEXT(5)=" "_$G(^VSIT(150.2,+$P($G(^DIC(150.9,1,4)),"^",2),0))
S XMTEXT="PXTEXT("
D ^XMD
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXICLN1 3214 printed Dec 13, 2024@02:28:55 Page 2
PXICLN1 ;ISL/dee - Cleanup routine for PX*1.0*1 ;9/3/96
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**1**;Aug 12, 1996
+2 ;
+3 DO PACKAGE
+4 DO QUE
+5 QUIT
+6 ;
PACKAGE ;Fix the PCE package file entry.
+1 NEW PXPCE,PXPCE,PXPCE22,PXVT,PXVTC,PXVT22,PXFDA,PXERROR
+2 SET PXPCE=$$PKG2IEN^VSIT("PX")
+3 SET PXPCEC=PXPCE_","
+4 if PXPCE'>0
QUIT
+5 SET PXVT=$$PKG2IEN^VSIT("VSIT")
+6 SET PXVTC=PXVT_","
+7 Begin DoDot:1
+8 NEW DIC,X,Y
+9 SET DIC="^DIC(9.4,"_PXPCE_",22,"
+10 SET DIC(0)="LX"
+11 SET DIC("P")=$PIECE(^DD(9.4,22,0),"^",2)
+12 SET DA(1)=PXPCE
+13 SET X="1.0"
+14 DO ^DIC
+15 SET PXPCE22=+Y
End DoDot:1
+16 IF $$GET1^DIQ(9.4,PXPCEC,2,"I","","PXERROR")=""
Begin DoDot:1
+17 SET PXFDA(9.4,PXPCEC,2)="Patient Care Encounter"
End DoDot:1
+18 IF $$GET1^DIQ(9.4,PXPCEC,11.01,"I","","PXERROR")=""
Begin DoDot:1
+19 SET PXFDA(9.4,PXPCEC,11.01)="SLC"
End DoDot:1
+20 IF $$GET1^DIQ(9.4,PXPCEC,11.3,"I","","PXERROR")=""
Begin DoDot:1
+21 SET PXFDA(9.4,PXPCEC,11.3)="I"
End DoDot:1
+22 IF $$GET1^DIQ(9.4,PXPCEC,13,"I","","PXERROR")'="1.0"
Begin DoDot:1
+23 SET PXFDA(9.4,PXPCEC,13)="1.0"
End DoDot:1
+24 IF PXVT>0
IF $GET(PXPCE22)>0
Begin DoDot:1
+25 Begin DoDot:2
+26 NEW DIC,X,Y
+27 SET DIC="^DIC(9.4,"_PXVT_",22,"
+28 SET DIC(0)="X"
+29 SET DIC("P")=$PIECE(^DD(9.4,22,0),"^",2)
+30 SET DA(1)=PXVT
+31 SET X="2.0"
+32 DO ^DIC
+33 SET PXVT22=+Y
End DoDot:2
+34 IF PXVT22>0
Begin DoDot:2
+35 NEW PXP22,PXV22
+36 SET PXP22=PXPCE22_","_PXPCEC
+37 SET PXV22=PXVT22_","_PXVTC
+38 IF $$GET1^DIQ(9.49,PXP22,1,"I","","PXERROR")=""
Begin DoDot:3
+39 SET X=$$GET1^DIQ(9.49,PXV22,1,"I","","PXERROR")
+40 IF X]""
SET PXFDA(9.49,PXP22,1)=X
End DoDot:3
+41 IF $$GET1^DIQ(9.49,PXP22,2,"I","","PXERROR")=""
Begin DoDot:3
+42 SET X=$$GET1^DIQ(9.49,PXV22,2,"I","","PXERROR")
+43 IF X]""
SET PXFDA(9.49,PXP22,2)=X
End DoDot:3
+44 IF $$GET1^DIQ(9.49,PXP22,3,"I","","PXERROR")=""
Begin DoDot:3
+45 SET X=$$GET1^DIQ(9.49,PXV22,3,"I","","PXERROR")
+46 IF X]""
SET PXFDA(9.49,PXP22,3)=X
End DoDot:3
End DoDot:2
End DoDot:1
+47 IF $DATA(PXFDA)
DO FILE^DIE("","PXFDA")
+48 QUIT
+49 ;
QUE ; Queue job to deleting the 800 node on all Stop Code Visits.
+1 NEW ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK,ZTSAVE
+2 DO BMES^XPDUTL("Deleting the 800 node on all Stop Code Visits.")
+3 SET ZTRTN="STOP800^PXICLN1"
+4 SET ZTIO=""
+5 SET ZTDESC="PX*1.0*1 tasked cleanup job"
+6 SET ZTDTH=$HOROLOG
+7 DO ^%ZTLOAD
+8 IF $DATA(ZTSK)
DO MES^XPDUTL("The job is task # "_ZTSK)
+9 IF '$DATA(ZTSK)
DO MES^XPDUTL("Could not start the task job.")
DO BMES^XPDUTL("You should start it by doing: D QUE^PXICLN1 at the programmers prompt.")
+10 QUIT
+11 ;
STOP800 ;Delete the 800 node from all Stop Code visits
+1 NEW PXIVSIT,VSIT
+2 SET PXIVSIT=0
+3 FOR
SET PXIVSIT=$ORDER(^AUPNVSIT(PXIVSIT))
if 'PXIVSIT
QUIT
Begin DoDot:1
+4 if '$DATA(^AUPNVSIT(PXIVSIT,800))
QUIT
+5 if $PIECE($GET(^AUPNVSIT(PXIVSIT,150)),"^",3)'="S"
QUIT
+6 KILL VSIT
+7 IF $PIECE(^AUPNVSIT(PXIVSIT,800),"^",1)]""
SET VSIT("SC")="@"
+8 IF $PIECE(^AUPNVSIT(PXIVSIT,800),"^",2)]""
SET VSIT("AO")="@"
+9 IF $PIECE(^AUPNVSIT(PXIVSIT,800),"^",3)]""
SET VSIT("IR")="@"
+10 IF $PIECE(^AUPNVSIT(PXIVSIT,800),"^",4)]""
SET VSIT("EC")="@"
+11 IF $DATA(VSIT)
SET VSIT("IEN")=PXIVSIT
DO UPD^VSIT
KILL ^AUPNVSIT(PXIVSIT,800)
End DoDot:1
+12 ;
MAIL ;Send mail messge that job is done. Also send to SLC IRMFO.
+1 NEW XMY,XMSUB,PXTEXT,XMTEXT
+2 SET XMY(DUZ)=""
+3 SET XMY("G.PCEINSTAL@ISC-SLC.DOMAIN.EXT")=""
+4 SET XMSUB="PX*1.0*1 Cleanup is finished"
+5 SET PXTEXT(1)="PX*1.0*1 Cleanup job is done."
+6 if $DATA(ZTQUEUED)
SET PXTEXT(2)="The task job number "_ZTQUEUED_" is finished."
+7 SET PXTEXT(3)=" "
+8 SET PXTEXT(4)="The site part if the Visit ID for this site is:"
+9 SET PXTEXT(5)=" "_$GET(^VSIT(150.2,+$PIECE($GET(^DIC(150.9,1,4)),"^",2),0))
+10 SET XMTEXT="PXTEXT("
+11 DO ^XMD
+12 QUIT
+13 ;
