DG53A564 ;ALB/PJR;POST INIT FOR PATCH 564 ; 6/9/04 3:51pm
;;5.3;Registration;**564**;Aug 13, 1993
;
EP ;Main entry point of post init routine
EN1 ;Queue seeding of new field
; Queue time is post install question POS1 (use NOW if not defined)
; If queued using entry point QUEUE, queue time will be prompted for
N ZTSK,ZTRTN,ZTIO,ZTDESC,ZTDTH,Y9
S X(1)=" "
S X(2)=" "
S X(3)="Routine to populate AGENT ORANGE EXPOSURE LOCATION field"
S X(4)="(#.3213) with VIETNAM for all patients claiming exposure"
S X(5)="to agent orange (AGENT ORANGE EXPOS. INDICATED? equals"
S X(6)="YES) and Exposure Location equals NULL will now be queued"
S X(7)=" "
D MES^XPDUTL(.X) K X
I $D(^XTMP("DG53A564",2)) D Q
.S X(1)=" "
.S X(2)="*****"
.S X(3)="Post init appears to be running. If it is not, delete the"
.S X(4)="node ^XTMP(""DG53A564"",2) and use line tag QUEUE^DG53A564"
.S X(5)="to [re]start the process."
.S X(6)="*****"
.S X(7)=" "
.D MES^XPDUTL(.X) K X
I $D(^XTMP("DG53A564",3)) D Q
.S X(1)=" "
.S X(2)="*****"
.S X(3)="Post init appears to have run to completion on "_$$FMTE^XLFDT(^XTMP("DG53A564",3))_"."
.S X(4)="If it did not, delete the node ^XTMP(""DG53A564"",3) and use"
.S X(5)="line tag QUEUE^DG53A564 to [re]start the process."
.S X(6)="*****"
.S X(7)=" "
.D MES^XPDUTL(.X) K X
S ZTRTN="SET^DG53A564",ZTIO=""
S ZTDTH=$H S X=+$G(XPDQUES("POS1")) S:(X) ZTDTH=$$FMTH^XLFDT(X) K:$G(DG53A564) ZTDTH
S ZTDESC="Initial seeding of AGENT ORANGE EXPOSURE LOCATION field"
D ^%ZTLOAD
I $G(ZTSK) D MES^XPDUTL("Task #"_ZTSK_" queued to start "_$$HTE^XLFDT($G(ZTSK("D")))) I 1
E D MES^XPDUTL("***** UNABLE TO QUEUE INITIAL SEEDING *****")
Q
;
SET ; This is the post-init to make sure all patients claiming
; exposure to agent orange have a selected location for the
; exposure. The initial setting is Vietnam.
N AOCNT,DFNCNT,DATIM,DFN,QFLG,Y,XMSUB,XMDUZ,XMTEXT,XMY,LASTDFN
S DATIM=$$DT^XLFDT()
S ^XTMP("DG53A564",0)=$$FMADD^XLFDT(DATIM,30)_"^"_DATIM
S ^XTMP("DG53A564",2)=1
S QFLG=0
S Y=$G(^XTMP("DG53A564",1))
S (DFN,LASTDFN)=+Y,DFNCNT=+$P(Y,"^",2),AOCNT=+$P(Y,"^",3)
F S DFN=$O(^DPT(DFN)) Q:'DFN D Q:QFLG
.S DFNCNT=DFNCNT+1
.S LASTDFN=DFN
.S Y9=$G(^DPT(DFN,.321)) I $P(Y9,U,2)="Y",$P(Y9,U,13)="" D
..S (DA,Y)=DFN,DIE="^DPT(",DR=".3213///VIETNAM" D ^DIE S AOCNT=AOCNT+1
.I '(DFNCNT#1000) S QFLG=$$S^%ZTLOAD("DFN: "_DFN) H 1
S ^XTMP("DG53A564",1)=LASTDFN_"^"_DFNCNT_"^"_AOCNT
K ^XTMP("DG53A564",2)
S DATIM=$$NOW^XLFDT()
I QFLG D I 1
.S ZTSTOP=1
.S Y=$$S^%ZTLOAD("STOPPED PROCESSING AT DFN "_LASTDFN)
E D
.S ^XTMP("DG53A564",3)=DATIM
.S ZTREQ="@"
S XMSUB="DG*5.3*564A post init has run to completion."
S:(QFLG) XMSUB="DG*5.3*564A post init was asked to stop."
K ^TMP($J,"DG53A564")
S ^TMP($J,"DG53A564",1,0)="Routine to populate AGENT ORANGE EXPOSURE LOCATION field"
S ^TMP($J,"DG53A564",2,0)="(#.3213) with VIETNAM for all patients claiming exposure"
S ^TMP($J,"DG53A564",3,0)="to agent orange (AGENT ORANGE EXPOS. INDICATED? equals"
S ^TMP($J,"DG53A564",4,0)="YES) and Exposure Location equals NULL"
S ^TMP($J,"DG53A564",5,0)="ran to completion on "_$$FMTE^XLFDT(DATIM)_"."
S ^TMP($J,"DG53A564",6,0)=" "
S ^TMP($J,"DG53A564",7,0)="Post init routine DG53A564 can be deleted."
I QFLG D
.S ^TMP($J,"DG53A564",4,0)="YES) was asked to stop on "_$$FMTE^XLFDT(DATIM)_"."
.S ^TMP($J,"DG53A564",5,0)=" "
.S ^TMP($J,"DG53A564",6,0)="Use the entry point QUEUE^DG53A564 to resume seeding."
S XMDUZ="Patch DG*5.3*564A"
S XMTEXT="^TMP($J,""DG53A564"","
S XMY(DUZ)=""
D ^XMD
K ^TMP($J,"DG53A564")
S ZTREQ="@"
Q
;
QUEUE ;Line tag for field to use to requeue seeding
N X,DG53A564
S DG53A564=1
D EN1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53A564 3763 printed Dec 13, 2024@02:39:33 Page 2
DG53A564 ;ALB/PJR;POST INIT FOR PATCH 564 ; 6/9/04 3:51pm
+1 ;;5.3;Registration;**564**;Aug 13, 1993
+2 ;
EP ;Main entry point of post init routine
EN1 ;Queue seeding of new field
+1 ; Queue time is post install question POS1 (use NOW if not defined)
+2 ; If queued using entry point QUEUE, queue time will be prompted for
+3 NEW ZTSK,ZTRTN,ZTIO,ZTDESC,ZTDTH,Y9
+4 SET X(1)=" "
+5 SET X(2)=" "
+6 SET X(3)="Routine to populate AGENT ORANGE EXPOSURE LOCATION field"
+7 SET X(4)="(#.3213) with VIETNAM for all patients claiming exposure"
+8 SET X(5)="to agent orange (AGENT ORANGE EXPOS. INDICATED? equals"
+9 SET X(6)="YES) and Exposure Location equals NULL will now be queued"
+10 SET X(7)=" "
+11 DO MES^XPDUTL(.X)
KILL X
+12 IF $DATA(^XTMP("DG53A564",2))
Begin DoDot:1
+13 SET X(1)=" "
+14 SET X(2)="*****"
+15 SET X(3)="Post init appears to be running. If it is not, delete the"
+16 SET X(4)="node ^XTMP(""DG53A564"",2) and use line tag QUEUE^DG53A564"
+17 SET X(5)="to [re]start the process."
+18 SET X(6)="*****"
+19 SET X(7)=" "
+20 DO MES^XPDUTL(.X)
KILL X
End DoDot:1
QUIT
+21 IF $DATA(^XTMP("DG53A564",3))
Begin DoDot:1
+22 SET X(1)=" "
+23 SET X(2)="*****"
+24 SET X(3)="Post init appears to have run to completion on "_$$FMTE^XLFDT(^XTMP("DG53A564",3))_"."
+25 SET X(4)="If it did not, delete the node ^XTMP(""DG53A564"",3) and use"
+26 SET X(5)="line tag QUEUE^DG53A564 to [re]start the process."
+27 SET X(6)="*****"
+28 SET X(7)=" "
+29 DO MES^XPDUTL(.X)
KILL X
End DoDot:1
QUIT
+30 SET ZTRTN="SET^DG53A564"
SET ZTIO=""
+31 SET ZTDTH=$HOROLOG
SET X=+$GET(XPDQUES("POS1"))
if (X)
SET ZTDTH=$$FMTH^XLFDT(X)
if $GET(DG53A564)
KILL ZTDTH
+32 SET ZTDESC="Initial seeding of AGENT ORANGE EXPOSURE LOCATION field"
+33 DO ^%ZTLOAD
+34 IF $GET(ZTSK)
DO MES^XPDUTL("Task #"_ZTSK_" queued to start "_$$HTE^XLFDT($GET(ZTSK("D"))))
IF 1
+35 IF '$TEST
DO MES^XPDUTL("***** UNABLE TO QUEUE INITIAL SEEDING *****")
+36 QUIT
+37 ;
SET ; This is the post-init to make sure all patients claiming
+1 ; exposure to agent orange have a selected location for the
+2 ; exposure. The initial setting is Vietnam.
+3 NEW AOCNT,DFNCNT,DATIM,DFN,QFLG,Y,XMSUB,XMDUZ,XMTEXT,XMY,LASTDFN
+4 SET DATIM=$$DT^XLFDT()
+5 SET ^XTMP("DG53A564",0)=$$FMADD^XLFDT(DATIM,30)_"^"_DATIM
+6 SET ^XTMP("DG53A564",2)=1
+7 SET QFLG=0
+8 SET Y=$GET(^XTMP("DG53A564",1))
+9 SET (DFN,LASTDFN)=+Y
SET DFNCNT=+$PIECE(Y,"^",2)
SET AOCNT=+$PIECE(Y,"^",3)
+10 FOR
SET DFN=$ORDER(^DPT(DFN))
if 'DFN
QUIT
Begin DoDot:1
+11 SET DFNCNT=DFNCNT+1
+12 SET LASTDFN=DFN
+13 SET Y9=$GET(^DPT(DFN,.321))
IF $PIECE(Y9,U,2)="Y"
IF $PIECE(Y9,U,13)=""
Begin DoDot:2
+14 SET (DA,Y)=DFN
SET DIE="^DPT("
SET DR=".3213///VIETNAM"
DO ^DIE
SET AOCNT=AOCNT+1
End DoDot:2
+15 IF '(DFNCNT#1000)
SET QFLG=$$S^%ZTLOAD("DFN: "_DFN)
HANG 1
End DoDot:1
if QFLG
QUIT
+16 SET ^XTMP("DG53A564",1)=LASTDFN_"^"_DFNCNT_"^"_AOCNT
+17 KILL ^XTMP("DG53A564",2)
+18 SET DATIM=$$NOW^XLFDT()
+19 IF QFLG
Begin DoDot:1
+20 SET ZTSTOP=1
+21 SET Y=$$S^%ZTLOAD("STOPPED PROCESSING AT DFN "_LASTDFN)
End DoDot:1
IF 1
+22 IF '$TEST
Begin DoDot:1
+23 SET ^XTMP("DG53A564",3)=DATIM
+24 SET ZTREQ="@"
End DoDot:1
+25 SET XMSUB="DG*5.3*564A post init has run to completion."
+26 if (QFLG)
SET XMSUB="DG*5.3*564A post init was asked to stop."
+27 KILL ^TMP($JOB,"DG53A564")
+28 SET ^TMP($JOB,"DG53A564",1,0)="Routine to populate AGENT ORANGE EXPOSURE LOCATION field"
+29 SET ^TMP($JOB,"DG53A564",2,0)="(#.3213) with VIETNAM for all patients claiming exposure"
+30 SET ^TMP($JOB,"DG53A564",3,0)="to agent orange (AGENT ORANGE EXPOS. INDICATED? equals"
+31 SET ^TMP($JOB,"DG53A564",4,0)="YES) and Exposure Location equals NULL"
+32 SET ^TMP($JOB,"DG53A564",5,0)="ran to completion on "_$$FMTE^XLFDT(DATIM)_"."
+33 SET ^TMP($JOB,"DG53A564",6,0)=" "
+34 SET ^TMP($JOB,"DG53A564",7,0)="Post init routine DG53A564 can be deleted."
+35 IF QFLG
Begin DoDot:1
+36 SET ^TMP($JOB,"DG53A564",4,0)="YES) was asked to stop on "_$$FMTE^XLFDT(DATIM)_"."
+37 SET ^TMP($JOB,"DG53A564",5,0)=" "
+38 SET ^TMP($JOB,"DG53A564",6,0)="Use the entry point QUEUE^DG53A564 to resume seeding."
End DoDot:1
+39 SET XMDUZ="Patch DG*5.3*564A"
+40 SET XMTEXT="^TMP($J,""DG53A564"","
+41 SET XMY(DUZ)=""
+42 DO ^XMD
+43 KILL ^TMP($JOB,"DG53A564")
+44 SET ZTREQ="@"
+45 QUIT
+46 ;
QUEUE ;Line tag for field to use to requeue seeding
+1 NEW X,DG53A564
+2 SET DG53A564=1
+3 DO EN1
+4 QUIT
