source: FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DG53342P.m@ 1796

Last change on this file since 1796 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 6.1 KB
Line 
1DG53342P ;BPFO/JRP;POST INIT FOR PATCH 342;1-FEB-2001
2 ;;5.3;Registration;**342**;Aug 13, 1993
3 ;
4POST ;Main entry point of post init routine
5 N X,FDAROOT,MSGROOT,FDAWP,IENROOT,IENS
6 ;Delete obsolete trigger
7 S X(1)=" "
8 S X(2)="Deleting trigger on VIETNAM SERVICE INDICATED? field"
9 S X(3)="(#.32101) that deletes Agent Orange data when set to NO"
10 S X(4)=" "
11 D MES^XPDUTL(.X) K X
12 D DELIX^DDMOD(2,.32101,3)
13 ;Update entry in INCONSISTENT DATA ELEMENTS file (#38.6)
14 S X(1)=" "
15 S X(2)="Updating definition of INCONSISTENT DATA ELEMENT number 25"
16 S X(3)=" "
17 D MES^XPDUTL(.X) K X
18 K FDAROOT,MSGROOT,FDAWP,IENROOT,IENS
19 S IENS="25,"
20 S:'$D(^DGIN(38.6,25)) IENS="+1,"
21 S FDAROOT(38.6,IENS,.01)="AO CLAIMED W/OUT VIETNAM POS"
22 S FDAROOT(38.6,IENS,2)="AGENT ORANGE EXPOSURE INDICATED WITHOUT VIETNAM ERA PERIOD OF SERVICE"
23 S FDAROOT(38.6,IENS,3)="SERVICE VERIFIED"
24 S FDAROOT(38.6,IENS,4)="NO"
25 S FDAROOT(38.6,IENS,5)="CHECK"
26 S FDAROOT(38.6,IENS,50)="FDAWP"
27 S FDAWP(1,0)="Inconsistency results if the patient is a veteran, the 'EXPOSED TO AGENT"
28 S FDAWP(2,0)="ORANGE' prompt is answered YES, and the 'PERIOD OF SERVICE' prompt is not"
29 S FDAWP(3,0)="answered VIETNAM ERA (#7)."
30 S IENROOT(1)=25
31 I IENS="25," D FILE^DIE("E","FDAROOT","MSGROOT") I 1
32 E D UPDATE^DIE("E","FDAROOT","IENROOT","MSGROOT")
33 I $D(MSGROOT("DIERR")) D
34 .N ERR,LINE,SPOT
35 .S SPOT=2
36 .S ERR=0
37 .F S ERR=+$O(MSGROOT("DIERR",ERR)) Q:'ERR D
38 ..I SPOT'=2 S X(SPOT)=" ",SPOT=SPOT+1
39 ..S LINE=0
40 ..F S LINE=+$O(MSGROOT("DIERR",ERR,"TEXT",LINE)) Q:'LINE D
41 ...S X(SPOT)=MSGROOT("DIERR",ERR,"TEXT",LINE)
42 ...S SPOT=SPOT+1
43 .S (X(1),X(SPOT))=" "
44 .D MES^XPDUTL(.X) K X
45 ;Create entry in INCONSISTENT DATA ELEMENTS file (#38.6)
46 S X(1)=" "
47 S X(2)="Creating definition of INCONSISTENT DATA ELEMENT number 60"
48 S X(3)=" "
49 D MES^XPDUTL(.X) K X
50 K FDAROOT,MSGROOT,IENROOT,FDAWP,IENS
51 S IENS="+1,"
52 S:$D(^DGIN(38.6,60)) IENS="60,"
53 S FDAROOT(38.6,IENS,.01)="AGENT ORANGE EXP LOC MISSING"
54 S FDAROOT(38.6,IENS,2)="'AGENT ORANGE EXPOSURE LOCATION' REQUIRED IF AO EXP INDICATED"
55 S FDAROOT(38.6,IENS,3)="SERVICE VERIFIED"
56 S FDAROOT(38.6,IENS,4)="NO"
57 S FDAROOT(38.6,IENS,5)="CHECK"
58 S FDAROOT(38.6,IENS,50)="FDAWP"
59 S FDAWP(1,0)="Inconsistency results if the 'EXPOSED TO AGENT ORANGE' prompt is answered"
60 S FDAWP(2,0)="YES and the 'AGENT ORANGE EXPOSURE LOCATION' prompt is not answered."
61 S IENROOT(1)=60
62 I IENS="+1," D UPDATE^DIE("E","FDAROOT","IENROOT","MSGROOT") I 1
63 E D FILE^DIE("E","FDAROOT","MSGROOT")
64 I $D(MSGROOT("DIERR")) D
65 .N ERR,LINE,SPOT
66 .S SPOT=2
67 .S ERR=0
68 .F S ERR=+$O(MSGROOT("DIERR",ERR)) Q:'ERR D
69 ..I SPOT'=2 S X(SPOT)=" ",SPOT=SPOT+1
70 ..S LINE=0
71 ..F S LINE=+$O(MSGROOT("DIERR",ERR,"TEXT",LINE)) Q:'LINE D
72 ...S X(SPOT)=MSGROOT("DIERR",ERR,"TEXT",LINE)
73 ...S SPOT=SPOT+1
74 .S (X(1),X(SPOT))=" "
75 .D MES^XPDUTL(.X) K X
76EN1 ;Queue seeding of new field
77 ; Queue time is post install question POS1 (use NOW if not defined)
78 ; If queued using entry point QUEUE, queue time will be prompted for
79 N ZTSK,ZTRTN,ZTIO,ZTDESC,ZTDTH
80 S X(1)=" "
81 S X(2)=" "
82 S X(3)="Routine to populate AGENT ORANGE EXPOSURE LOCATION field"
83 S X(4)="(#.3213) with VIETNAM for all patients claiming exposure"
84 S X(5)="to agent orange (AGENT ORANGE EXPOS. INDICATED? equals"
85 S X(6)="YES) will now be queued"
86 S X(7)=" "
87 D MES^XPDUTL(.X) K X
88 I $D(^XTMP("DG53342P",2)) D Q
89 .S X(1)=" "
90 .S X(2)="*****"
91 .S X(3)="Post init appears to be running. If it is not, delete the"
92 .S X(4)="node ^XTMP(""DG53342P"",2) and use line tag QUEUE^DG53342P"
93 .S X(5)="to [re]start the process."
94 .S X(6)="*****"
95 .S X(7)=" "
96 .D MES^XPDUTL(.X) K X
97 I $D(^XTMP("DG53342P",3)) D Q
98 .S X(1)=" "
99 .S X(2)="*****"
100 .S X(3)="Post init appears to have run to completion on "_$$FMTE^XLFDT(^XTMP("DG53342P",3))_"."
101 .S X(4)="If it did not, delete the node ^XTMP(""DG53342P"",3) and use"
102 .S X(5)="line tag QUEUE^DG53342P to [re]start the process."
103 .S X(6)="*****"
104 .S X(7)=" "
105 .D MES^XPDUTL(.X) K X
106 S ZTRTN="SET^DG53342P",ZTIO=""
107 S ZTDTH=$H S X=+$G(XPDQUES("POS1")) S:(X) ZTDTH=$$FMTH^XLFDT(X) K:$G(DG53342P) ZTDTH
108 S ZTDESC="Initial seeding of AGENT ORANGE EXPOSURE LOCATION field"
109 D ^%ZTLOAD
110 I $G(ZTSK) D MES^XPDUTL("Task #"_ZTSK_" queued to start "_$$HTE^XLFDT($G(ZTSK("D")))) I 1
111 E D MES^XPDUTL("***** UNABLE TO QUEUE INITIAL SEEDING *****")
112 Q
113 ;
114SET ; This is the post-init to make sure all patients claiming
115 ; exposure to agent orange have a selected location for the
116 ; exposure. The initial setting is Vietnam.
117 N AOCNT,DFNCNT,DATIM,DFN,QFLG,Y,XMSUB,XMDUZ,XMTEXT,XMY,LASTDFN
118 S DATIM=$$DT^XLFDT()
119 S ^XTMP("DG53342P",0)=$$FMADD^XLFDT(DATIM,30)_"^"_DATIM
120 S ^XTMP("DG53342P",2)=1
121 S QFLG=0
122 S Y=$G(^XTMP("DG53342P",1))
123 S (DFN,LASTDFN)=+Y,DFNCNT=+$P(Y,"^",2),AOCNT=+$P(Y,"^",3)
124 F S DFN=$O(^DPT(DFN)) Q:'DFN D Q:QFLG
125 .S DFNCNT=DFNCNT+1
126 .S LASTDFN=DFN
127 .S Y=$G(^DPT(DFN,.321))
128 .I $P(Y,U,2)="Y" S:($P(Y,U,13)="") $P(^DPT(DFN,.321),U,13)="V",AOCNT=AOCNT+1
129 .I '(DFNCNT#100) S QFLG=$$S^%ZTLOAD("DFN: "_DFN) H 5
130 S ^XTMP("DG53342P",1)=LASTDFN_"^"_DFNCNT_"^"_AOCNT
131 K ^XTMP("DG53342P",2)
132 S DATIM=$$NOW^XLFDT()
133 I QFLG D I 1
134 .S ZTSTOP=1
135 .S Y=$$S^%ZTLOAD("STOPPED PROCESSING AT DFN "_LASTDFN)
136 E D
137 .S ^XTMP("DG53342P",3)=DATIM
138 .S ZTREQ="@"
139 S XMSUB="DG*5.3*342 post init has run to completion."
140 S:(QFLG) XMSUB="DG*5.3*342 post init was asked to stop."
141 K ^TMP($J,"DG53342P")
142 S ^TMP($J,"DG53342P",1,0)="Routine to populate AGENT ORANGE EXPOSURE LOCATION field"
143 S ^TMP($J,"DG53342P",2,0)="(#.3213) with VIETNAM for all patients claiming exposure"
144 S ^TMP($J,"DG53342P",3,0)="to agent orange (AGENT ORANGE EXPOS. INDICATED? equals"
145 S ^TMP($J,"DG53342P",4,0)="YES) ran to completion on "_$$FMTE^XLFDT(DATIM)_"."
146 S ^TMP($J,"DG53342P",5,0)=" "
147 S ^TMP($J,"DG53342P",6,0)="Post init routine DG53342P can be deleted."
148 I QFLG D
149 .S ^TMP($J,"DG53342P",4,0)="YES) was asked to stop on "_$$FMTE^XLFDT(DATIM)_"."
150 .S ^TMP($J,"DG53342P",5,0)=" "
151 .S ^TMP($J,"DG53342P",6,0)="Use the entry point QUEUE^DG53342P to resume seeding."
152 S XMDUZ="Patch DG*5.3*342"
153 S XMTEXT="^TMP($J,""DG53342P"","
154 S XMY(DUZ)=""
155 D ^XMD
156 K ^TMP($J,"DG53342P")
157 S ZTREQ="@"
158 Q
159 ;
160QUEUE ;Line tag for field to use to requeue seeding
161 N X,DG53342P
162 S DG53342P=1
163 D EN1
164 Q
Note: See TracBrowser for help on using the repository browser.