- 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 Mar 13, 2025@21:33:39 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 ;
