DG53342P.m

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 ---DG53342P   6370     printed  Apr 23, 2025@18:51:13                                                                                                                                                                                                    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