DG53342P ;BPFO/JRP;POST INIT FOR PATCH 342;1-FEB-2001
;;5.3;Registration;**342**;Aug 13, 1993
;
POST ;Main entry point of post init routine
N X,FDAROOT,MSGROOT,FDAWP,IENROOT,IENS
;Delete obsolete trigger
S X(1)=" "
S X(2)="Deleting trigger on VIETNAM SERVICE INDICATED? field"
S X(3)="(#.32101) that deletes Agent Orange data when set to NO"
S X(4)=" "
D MES^XPDUTL(.X) K X
D DELIX^DDMOD(2,.32101,3)
;Update entry in INCONSISTENT DATA ELEMENTS file (#38.6)
S X(1)=" "
S X(2)="Updating definition of INCONSISTENT DATA ELEMENT number 25"
S X(3)=" "
D MES^XPDUTL(.X) K X
K FDAROOT,MSGROOT,FDAWP,IENROOT,IENS
S IENS="25,"
S:'$D(^DGIN(38.6,25)) IENS="+1,"
S FDAROOT(38.6,IENS,.01)="AO CLAIMED W/OUT VIETNAM POS"
S FDAROOT(38.6,IENS,2)="AGENT ORANGE EXPOSURE INDICATED WITHOUT VIETNAM ERA PERIOD OF SERVICE"
S FDAROOT(38.6,IENS,3)="SERVICE VERIFIED"
S FDAROOT(38.6,IENS,4)="NO"
S FDAROOT(38.6,IENS,5)="CHECK"
S FDAROOT(38.6,IENS,50)="FDAWP"
S FDAWP(1,0)="Inconsistency results if the patient is a veteran, the 'EXPOSED TO AGENT"
S FDAWP(2,0)="ORANGE' prompt is answered YES, and the 'PERIOD OF SERVICE' prompt is not"
S FDAWP(3,0)="answered VIETNAM ERA (#7)."
S IENROOT(1)=25
I IENS="25," D FILE^DIE("E","FDAROOT","MSGROOT") I 1
E D UPDATE^DIE("E","FDAROOT","IENROOT","MSGROOT")
I $D(MSGROOT("DIERR")) D
.N ERR,LINE,SPOT
.S SPOT=2
.S ERR=0
.F S ERR=+$O(MSGROOT("DIERR",ERR)) Q:'ERR D
..I SPOT'=2 S X(SPOT)=" ",SPOT=SPOT+1
..S LINE=0
..F S LINE=+$O(MSGROOT("DIERR",ERR,"TEXT",LINE)) Q:'LINE D
...S X(SPOT)=MSGROOT("DIERR",ERR,"TEXT",LINE)
...S SPOT=SPOT+1
.S (X(1),X(SPOT))=" "
.D MES^XPDUTL(.X) K X
;Create entry in INCONSISTENT DATA ELEMENTS file (#38.6)
S X(1)=" "
S X(2)="Creating definition of INCONSISTENT DATA ELEMENT number 60"
S X(3)=" "
D MES^XPDUTL(.X) K X
K FDAROOT,MSGROOT,IENROOT,FDAWP,IENS
S IENS="+1,"
S:$D(^DGIN(38.6,60)) IENS="60,"
S FDAROOT(38.6,IENS,.01)="AGENT ORANGE EXP LOC MISSING"
S FDAROOT(38.6,IENS,2)="'AGENT ORANGE EXPOSURE LOCATION' REQUIRED IF AO EXP INDICATED"
S FDAROOT(38.6,IENS,3)="SERVICE VERIFIED"
S FDAROOT(38.6,IENS,4)="NO"
S FDAROOT(38.6,IENS,5)="CHECK"
S FDAROOT(38.6,IENS,50)="FDAWP"
S FDAWP(1,0)="Inconsistency results if the 'EXPOSED TO AGENT ORANGE' prompt is answered"
S FDAWP(2,0)="YES and the 'AGENT ORANGE EXPOSURE LOCATION' prompt is not answered."
S IENROOT(1)=60
I IENS="+1," D UPDATE^DIE("E","FDAROOT","IENROOT","MSGROOT") I 1
E D FILE^DIE("E","FDAROOT","MSGROOT")
I $D(MSGROOT("DIERR")) D
.N ERR,LINE,SPOT
.S SPOT=2
.S ERR=0
.F S ERR=+$O(MSGROOT("DIERR",ERR)) Q:'ERR D
..I SPOT'=2 S X(SPOT)=" ",SPOT=SPOT+1
..S LINE=0
..F S LINE=+$O(MSGROOT("DIERR",ERR,"TEXT",LINE)) Q:'LINE D
...S X(SPOT)=MSGROOT("DIERR",ERR,"TEXT",LINE)
...S SPOT=SPOT+1
.S (X(1),X(SPOT))=" "
.D MES^XPDUTL(.X) K X
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
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) will now be queued"
S X(7)=" "
D MES^XPDUTL(.X) K X
I $D(^XTMP("DG53342P",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(""DG53342P"",2) and use line tag QUEUE^DG53342P"
.S X(5)="to [re]start the process."
.S X(6)="*****"
.S X(7)=" "
.D MES^XPDUTL(.X) K X
I $D(^XTMP("DG53342P",3)) D Q
.S X(1)=" "
.S X(2)="*****"
.S X(3)="Post init appears to have run to completion on "_$$FMTE^XLFDT(^XTMP("DG53342P",3))_"."
.S X(4)="If it did not, delete the node ^XTMP(""DG53342P"",3) and use"
.S X(5)="line tag QUEUE^DG53342P to [re]start the process."
.S X(6)="*****"
.S X(7)=" "
.D MES^XPDUTL(.X) K X
S ZTRTN="SET^DG53342P",ZTIO=""
S ZTDTH=$H S X=+$G(XPDQUES("POS1")) S:(X) ZTDTH=$$FMTH^XLFDT(X) K:$G(DG53342P) 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("DG53342P",0)=$$FMADD^XLFDT(DATIM,30)_"^"_DATIM
S ^XTMP("DG53342P",2)=1
S QFLG=0
S Y=$G(^XTMP("DG53342P",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 Y=$G(^DPT(DFN,.321))
.I $P(Y,U,2)="Y" S:($P(Y,U,13)="") $P(^DPT(DFN,.321),U,13)="V",AOCNT=AOCNT+1
.I '(DFNCNT#100) S QFLG=$$S^%ZTLOAD("DFN: "_DFN) H 5
S ^XTMP("DG53342P",1)=LASTDFN_"^"_DFNCNT_"^"_AOCNT
K ^XTMP("DG53342P",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("DG53342P",3)=DATIM
.S ZTREQ="@"
S XMSUB="DG*5.3*342 post init has run to completion."
S:(QFLG) XMSUB="DG*5.3*342 post init was asked to stop."
K ^TMP($J,"DG53342P")
S ^TMP($J,"DG53342P",1,0)="Routine to populate AGENT ORANGE EXPOSURE LOCATION field"
S ^TMP($J,"DG53342P",2,0)="(#.3213) with VIETNAM for all patients claiming exposure"
S ^TMP($J,"DG53342P",3,0)="to agent orange (AGENT ORANGE EXPOS. INDICATED? equals"
S ^TMP($J,"DG53342P",4,0)="YES) ran to completion on "_$$FMTE^XLFDT(DATIM)_"."
S ^TMP($J,"DG53342P",5,0)=" "
S ^TMP($J,"DG53342P",6,0)="Post init routine DG53342P can be deleted."
I QFLG D
.S ^TMP($J,"DG53342P",4,0)="YES) was asked to stop on "_$$FMTE^XLFDT(DATIM)_"."
.S ^TMP($J,"DG53342P",5,0)=" "
.S ^TMP($J,"DG53342P",6,0)="Use the entry point QUEUE^DG53342P to resume seeding."
S XMDUZ="Patch DG*5.3*342"
S XMTEXT="^TMP($J,""DG53342P"","
S XMY(DUZ)=""
D ^XMD
K ^TMP($J,"DG53342P")
S ZTREQ="@"
Q
;
QUEUE ;Line tag for field to use to requeue seeding
N X,DG53342P
S DG53342P=1
D EN1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53342P 6370 printed Apr 09, 2024@21:55 Page 2
DG53342P ;BPFO/JRP;POST INIT FOR PATCH 342;1-FEB-2001
+1 ;;5.3;Registration;**342**;Aug 13, 1993
+2 ;
POST ;Main entry point of post init routine
+1 NEW X,FDAROOT,MSGROOT,FDAWP,IENROOT,IENS
+2 ;Delete obsolete trigger
+3 SET X(1)=" "
+4 SET X(2)="Deleting trigger on VIETNAM SERVICE INDICATED? field"
+5 SET X(3)="(#.32101) that deletes Agent Orange data when set to NO"
+6 SET X(4)=" "
+7 DO MES^XPDUTL(.X)
KILL X
+8 DO DELIX^DDMOD(2,.32101,3)
+9 ;Update entry in INCONSISTENT DATA ELEMENTS file (#38.6)
+10 SET X(1)=" "
+11 SET X(2)="Updating definition of INCONSISTENT DATA ELEMENT number 25"
+12 SET X(3)=" "
+13 DO MES^XPDUTL(.X)
KILL X
+14 KILL FDAROOT,MSGROOT,FDAWP,IENROOT,IENS
+15 SET IENS="25,"
+16 if '$DATA(^DGIN(38.6,25))
SET IENS="+1,"
+17 SET FDAROOT(38.6,IENS,.01)="AO CLAIMED W/OUT VIETNAM POS"
+18 SET FDAROOT(38.6,IENS,2)="AGENT ORANGE EXPOSURE INDICATED WITHOUT VIETNAM ERA PERIOD OF SERVICE"
+19 SET FDAROOT(38.6,IENS,3)="SERVICE VERIFIED"
+20 SET FDAROOT(38.6,IENS,4)="NO"
+21 SET FDAROOT(38.6,IENS,5)="CHECK"
+22 SET FDAROOT(38.6,IENS,50)="FDAWP"
+23 SET FDAWP(1,0)="Inconsistency results if the patient is a veteran, the 'EXPOSED TO AGENT"
+24 SET FDAWP(2,0)="ORANGE' prompt is answered YES, and the 'PERIOD OF SERVICE' prompt is not"
+25 SET FDAWP(3,0)="answered VIETNAM ERA (#7)."
+26 SET IENROOT(1)=25
+27 IF IENS="25,"
DO FILE^DIE("E","FDAROOT","MSGROOT")
IF 1
+28 IF '$TEST
DO UPDATE^DIE("E","FDAROOT","IENROOT","MSGROOT")
+29 IF $DATA(MSGROOT("DIERR"))
Begin DoDot:1
+30 NEW ERR,LINE,SPOT
+31 SET SPOT=2
+32 SET ERR=0
+33 FOR
SET ERR=+$ORDER(MSGROOT("DIERR",ERR))
if 'ERR
QUIT
Begin DoDot:2
+34 IF SPOT'=2
SET X(SPOT)=" "
SET SPOT=SPOT+1
+35 SET LINE=0
+36 FOR
SET LINE=+$ORDER(MSGROOT("DIERR",ERR,"TEXT",LINE))
if 'LINE
QUIT
Begin DoDot:3
+37 SET X(SPOT)=MSGROOT("DIERR",ERR,"TEXT",LINE)
+38 SET SPOT=SPOT+1
End DoDot:3
End DoDot:2
+39 SET (X(1),X(SPOT))=" "
+40 DO MES^XPDUTL(.X)
KILL X
End DoDot:1
+41 ;Create entry in INCONSISTENT DATA ELEMENTS file (#38.6)
+42 SET X(1)=" "
+43 SET X(2)="Creating definition of INCONSISTENT DATA ELEMENT number 60"
+44 SET X(3)=" "
+45 DO MES^XPDUTL(.X)
KILL X
+46 KILL FDAROOT,MSGROOT,IENROOT,FDAWP,IENS
+47 SET IENS="+1,"
+48 if $DATA(^DGIN(38.6,60))
SET IENS="60,"
+49 SET FDAROOT(38.6,IENS,.01)="AGENT ORANGE EXP LOC MISSING"
+50 SET FDAROOT(38.6,IENS,2)="'AGENT ORANGE EXPOSURE LOCATION' REQUIRED IF AO EXP INDICATED"
+51 SET FDAROOT(38.6,IENS,3)="SERVICE VERIFIED"
+52 SET FDAROOT(38.6,IENS,4)="NO"
+53 SET FDAROOT(38.6,IENS,5)="CHECK"
+54 SET FDAROOT(38.6,IENS,50)="FDAWP"
+55 SET FDAWP(1,0)="Inconsistency results if the 'EXPOSED TO AGENT ORANGE' prompt is answered"
+56 SET FDAWP(2,0)="YES and the 'AGENT ORANGE EXPOSURE LOCATION' prompt is not answered."
+57 SET IENROOT(1)=60
+58 IF IENS="+1,"
DO UPDATE^DIE("E","FDAROOT","IENROOT","MSGROOT")
IF 1
+59 IF '$TEST
DO FILE^DIE("E","FDAROOT","MSGROOT")
+60 IF $DATA(MSGROOT("DIERR"))
Begin DoDot:1
+61 NEW ERR,LINE,SPOT
+62 SET SPOT=2
+63 SET ERR=0
+64 FOR
SET ERR=+$ORDER(MSGROOT("DIERR",ERR))
if 'ERR
QUIT
Begin DoDot:2
+65 IF SPOT'=2
SET X(SPOT)=" "
SET SPOT=SPOT+1
+66 SET LINE=0
+67 FOR
SET LINE=+$ORDER(MSGROOT("DIERR",ERR,"TEXT",LINE))
if 'LINE
QUIT
Begin DoDot:3
+68 SET X(SPOT)=MSGROOT("DIERR",ERR,"TEXT",LINE)
+69 SET SPOT=SPOT+1
End DoDot:3
End DoDot:2
+70 SET (X(1),X(SPOT))=" "
+71 DO MES^XPDUTL(.X)
KILL X
End DoDot:1
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
+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) will now be queued"
+10 SET X(7)=" "
+11 DO MES^XPDUTL(.X)
KILL X
+12 IF $DATA(^XTMP("DG53342P",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(""DG53342P"",2) and use line tag QUEUE^DG53342P"
+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("DG53342P",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("DG53342P",3))_"."
+25 SET X(4)="If it did not, delete the node ^XTMP(""DG53342P"",3) and use"
+26 SET X(5)="line tag QUEUE^DG53342P 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^DG53342P"
SET ZTIO=""
+31 SET ZTDTH=$HOROLOG
SET X=+$GET(XPDQUES("POS1"))
if (X)
SET ZTDTH=$$FMTH^XLFDT(X)
if $GET(DG53342P)
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("DG53342P",0)=$$FMADD^XLFDT(DATIM,30)_"^"_DATIM
+6 SET ^XTMP("DG53342P",2)=1
+7 SET QFLG=0
+8 SET Y=$GET(^XTMP("DG53342P",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 Y=$GET(^DPT(DFN,.321))
+14 IF $PIECE(Y,U,2)="Y"
if ($PIECE(Y,U,13)="")
SET $PIECE(^DPT(DFN,.321),U,13)="V"
SET AOCNT=AOCNT+1
+15 IF '(DFNCNT#100)
SET QFLG=$$S^%ZTLOAD("DFN: "_DFN)
HANG 5
End DoDot:1
if QFLG
QUIT
+16 SET ^XTMP("DG53342P",1)=LASTDFN_"^"_DFNCNT_"^"_AOCNT
+17 KILL ^XTMP("DG53342P",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("DG53342P",3)=DATIM
+24 SET ZTREQ="@"
End DoDot:1
+25 SET XMSUB="DG*5.3*342 post init has run to completion."
+26 if (QFLG)
SET XMSUB="DG*5.3*342 post init was asked to stop."
+27 KILL ^TMP($JOB,"DG53342P")
+28 SET ^TMP($JOB,"DG53342P",1,0)="Routine to populate AGENT ORANGE EXPOSURE LOCATION field"
+29 SET ^TMP($JOB,"DG53342P",2,0)="(#.3213) with VIETNAM for all patients claiming exposure"
+30 SET ^TMP($JOB,"DG53342P",3,0)="to agent orange (AGENT ORANGE EXPOS. INDICATED? equals"
+31 SET ^TMP($JOB,"DG53342P",4,0)="YES) ran to completion on "_$$FMTE^XLFDT(DATIM)_"."
+32 SET ^TMP($JOB,"DG53342P",5,0)=" "
+33 SET ^TMP($JOB,"DG53342P",6,0)="Post init routine DG53342P can be deleted."
+34 IF QFLG
Begin DoDot:1
+35 SET ^TMP($JOB,"DG53342P",4,0)="YES) was asked to stop on "_$$FMTE^XLFDT(DATIM)_"."
+36 SET ^TMP($JOB,"DG53342P",5,0)=" "
+37 SET ^TMP($JOB,"DG53342P",6,0)="Use the entry point QUEUE^DG53342P to resume seeding."
End DoDot:1
+38 SET XMDUZ="Patch DG*5.3*342"
+39 SET XMTEXT="^TMP($J,""DG53342P"","
+40 SET XMY(DUZ)=""
+41 DO ^XMD
+42 KILL ^TMP($JOB,"DG53342P")
+43 SET ZTREQ="@"
+44 QUIT
+45 ;
QUEUE ;Line tag for field to use to requeue seeding
+1 NEW X,DG53342P
+2 SET DG53342P=1
+3 DO EN1
+4 QUIT
