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

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

initial load of FOIAVistA 6/30/08 version
File size: 6.6 KB
Line 
1DGNTQ ;ALB/RPM - NOSE/THROAT RADIUM TREATMENT QUESTIONS ; 8/24/01 12:59pm
2 ;;5.3;Registration;**397**;Aug 13, 1993
3 Q
4 ;
5ASKSTAT(DGDIRA,DGDIRB,DGDIR0) ;
6 ;
7 ; Input
8 ; DGDIR0 - DIR(0) string
9 ; DGDIRA - DIR("A") string
10 ; DGDIRB - DIR("B") string
11 ;
12 ; Output
13 ; DGRSLT has the following values:
14 ; 0 - if user up-arrows, times out, or enters null
15 ; Y - user response
16 ;
17 K DIRUT
18 S DIR(0)=DGDIR0
19 S DIR("A")=DGDIRA
20 S DIR("B")=DGDIRB
21 D ^DIR
22 K DIR
23 I $D(DIRUT) S DGRSLT=0
24 E S DGRSLT=Y
25 ;
26 Q DGRSLT
27 ;
28REG(DGDFN) ;Entry point from REGISTRATION
29 ;This sub-routine asks the Nose/Throat Radium Treatment questions
30 ;for Screen 6 of LOAD/EDIT PATIENT DATA. The answers are filed in
31 ;the NTR HISTORY file (#28.11) using the $$FILENTR^DGNTAPI API.
32 ;A caret "^" entered as an answer to any of the questions will cause
33 ;the sub-routine to QUIT without filing any data.
34 ;A user possessing the DGNT VERIFY security key will have additional
35 ;verification questions asked.
36 ;
37 ; Input
38 ; DGDFN - IEN to PATIENT file (#2)
39 ;
40 ; Output none
41 ;
42 N I,X,Y ;protect FileMan ^DIE variables
43 N DGNTIEN ;IEN from existing record from $$GETCUR API call
44 N DGNT ;data array from $$GETCUR API call
45 N DGDFLT ;default answer array
46 N DGUPD ;question response array subscripted by "NTR","AVI","SUB"
47 N DGRSLT ;result of filer API
48 N DGX ;generic counter
49 N DGXMT ;HL7 transmit flag
50 ;
51 ;initialize defaults
52 S DGNTIEN=$$GETCUR^DGNTAPI(DGDFN,"DGNT")
53 I 'DGNTIEN D
54 . F DGX="NTR","AVI","SUB","EDT","EUSR","HNC","HDT","HUSR","HSIT","VER","VDT","VUSR","VSIT" S DGUPD(DGX)=""
55 I +DGNTIEN>0,$D(DGNT) M DGUPD=DGNT
56 F DGX="NTR","AVI","SUB" D
57 . S DGDFLT(DGX)=$S($P(DGUPD(DGX),"^",2)]"":$P(DGUPD(DGX),"^",2),1:"NO")
58 ;
59 ;call reader API $$ASKSTAT passing DFN,DIR(0),DIR("B"),DIR("A")
60 S DGUPD("NTR")=$$ASKSTAT("Did you receive Nose or Throat Radium Treatments in the military? ",DGDFLT("NTR"),"28.11,.04AO")
61 Q:DGUPD("NTR")=0 ;user entered "^" or timed out
62 I DGUPD("NTR")="Y"!(DGUPD("NTR")="U") D
63 . S DGUPD("AVI")=$S($$DATOK(DGDFN,2550131):$$ASKSTAT("Did you serve as an aviator in the military before Jan 31, 1955? ",DGDFLT("AVI"),"28.11,.05AO"),1:"")
64 . Q:DGUPD("AVI")=0
65 . S DGUPD("SUB")=$S($$DATOK(DGDFN,2650101):$$ASKSTAT("Did you have submarine training in the military before Jan 1, 1965? ",DGDFLT("SUB"),"28.11,.06AO"),1:"")
66 ;quit if user entered "^" or timed out during questions
67 I DGUPD("NTR")=0!(DGUPD("AVI")=0!(DGUPD("SUB")=0)) Q
68 ;check for value change and add entry date, user, site and clear
69 ;the previous verification/head&neck values
70 F DGX="NTR","AVI","SUB" I DGUPD(DGX)'=$P($G(DGNT(DGX)),"^") D Q
71 . S DGUPD("EDT")=$$NOW^XLFDT
72 . S DGUPD("EUSR")=DUZ
73 . I DGUPD("VDT")]"" D ;clear verification
74 . . F DGX="VER","VDT","VUSR","VSIT" S DGUPD(DGX)=""
75 . I DGUPD("HDT")]"" D ;clear Head/Neck DX
76 . . F DGX="HNC","HDT","HUSR","HSIT" S DGUPD(DGX)=""
77 ;can user verify?
78 I $D(^XUSEC("DGNT VERIFY",DUZ)),(DGUPD("NTR")="Y"!(DGUPD("NTR")="U")) D VERIFY(DGDFN,.DGUPD)
79 ;flip Unknown to Yes if verified by Mil Med Record
80 I DGUPD("NTR")="U",DGUPD("VER")="M" S DGUPD("NTR")="Y"
81 ;file the data using filer API passing DFN and response array
82 F DGX="NTR","AVI","SUB","VER","HNC" S DGUPD(DGX)=$P(DGUPD(DGX),"^")
83 I $$CHANGE^DGNTUT(DGDFN,.DGUPD) D
84 . I DGUPD("NTR")="N" D
85 . . S DGUPD("VDT")=$$NOW^XLFDT
86 . . S DGUPD("VSIT")=$$SITE^DGNTUT
87 . S DGXMT=$S(DGUPD("VDT")'="":1,1:0)
88 . S DGRSLT=$$FILENTR^DGNTAPI(DGDFN,.DGUPD,DGXMT)
89REGQ Q
90 ;
91VERIFY(DGDFN,DGVUPD) ;Ask verification questions
92 ;
93 ; Input
94 ; DGDFN - IEN to PATIENT file (#2)
95 ; DGVUPD - array of question responses
96 ;
97 ; Output none
98 ;
99 N DGX ;generic index
100 N DGDFLT ;default answer array
101 ;
102 ;set up default answer array
103 S DGDFLT("VER")=$S($P($G(DGVUPD("VER")),"^",1)]"":$P(DGVUPD("VER"),"^",1),1:"")
104 S DGDFLT("HNC")=$S($P($G(DGVUPD("HNC")),"^",2)]"":$P(DGVUPD("HNC"),"^",2),1:"")
105 I $$ASKSTAT("Do you want to verify now? ","NO","YAO") D
106 . S DGVUPD("VER")=$$ASKSTAT("Nose and throat radium treatment verified by: ",DGDFLT("VER"),"28.11,1.01AO")
107 . I DGVUPD("VER")=0 S DGVUPD("VER")=DGDFLT("VER") Q
108 . I DGVUPD("VER")'=DGDFLT("VER") D
109 . . S DGVUPD("VDT")=$$NOW^XLFDT
110 . . S DGVUPD("VUSR")=DUZ
111 . . S DGVUPD("VSIT")=$$SITE^DGNTUT
112 . I DGVUPD("VER")'="N" D
113 . . S DGVUPD("HNC")=$$ASKSTAT("Has the veteran been diagnosed with Cancer of the Head and/or Neck? ",$S(DGDFLT("HNC")]"":DGDFLT("HNC"),1:"NO"),"28.11,2.01AO")
114 . . I DGVUPD("HNC")=0 S DGVUPD("HNC")=$E(DGDFLT("HNC")) Q
115 . . I DGVUPD("HNC")="N" S DGVUPD("HNC")=""
116 . . I DGVUPD("HNC")'=DGDFLT("HNC") D
117 . . . S DGVUPD("HDT")=$$NOW^XLFDT
118 . . . S DGVUPD("HUSR")=DUZ
119 . . . S DGVUPD("HSIT")=$$SITE^DGNTUT
120 Q
121 ;
122DATOK(DGDFN,DGDATE) ;Validate dates before asking questions
123 ;Call $$SVCCHK to check Service Entry dates and if no Service
124 ;Entry dates are found then at least validate against DOB.
125 ;
126 ; Input
127 ; DGDFN - IEN to PATIENT file (#2)
128 ; DGDATE- FM forumat date to validate agains
129 ;
130 ; Output
131 ; DGRSLT - 0 = don't ask question
132 ; 1 = ask question
133 ;
134 N DGRSLT
135 S DGDFN=$G(DGDFN)
136 S DGDATE=$G(DGDATE)
137 S DGRSLT=1
138 S DGRSLT=$$SVCCHK(DGDFN,DGDATE)
139 I DGRSLT<0 S DGRSLT=$$DOBCHK(DGDFN,DGDATE)
140 Q DGRSLT
141 ;
142SVCCHK(DGDFN,DGDATE) ;Did veteran serve prior to DGDATE?
143 ;This function searches the veteran's Service Entry dates to find the
144 ;earliest date. If a Service Entry date is found then it is compared
145 ;against the DGDATE parameter and returns a zero ("0") if DGDATE
146 ;precedes the Service Entry date. If the Service Entry date precedes
147 ;DGDATE a one ("1") is returned.
148 ;
149 ; Input
150 ; DGDFN - IEN to PATIENT file (#2)
151 ; DGDATE - FM format date to validate agains
152 ;
153 ; Output
154 ; DGRSLT - 0 = DGDATE precedes earliest Service Entry date.
155 ; 1 = Service Entry date precedes DGDATE
156 ; -1 = no Service Entry date found.
157 ;
158 N DFN,VASV,VAERR ;SVC^VADPT variables
159 N DGSVCE ;Service Entry date
160 N DGRSLT
161 S DGDFN=+$G(DGDFN)
162 S DGDATE=+$G(DGDATE)
163 S DGRSLT=-1
164 S DFN=DGDFN
165 D SVC^VADPT
166 F DGX=8:-1:6 I +$G(VASV(DGX,4))>0 D Q
167 . S DGRSLT=1
168 . I DGDATE<+$G(VASV(DGX,4)) S DGRSLT=0
169 Q DGRSLT
170 ;
171DOBCHK(DGDFN,DGDATE) ;Was veteran too young to have served at DGDATE?
172 ;This function compares the veteran's DOB against DGDATE to determine
173 ;if the veteran was less than 15 years old at DGDATE. This logic
174 ;is based on POS^DGRPDD1.
175 ;
176 ; Input
177 ; DGDFN - IEN to PATIENT file (#2)
178 ; DGDATE- FM format date to validate against
179 ;
180 ; Output
181 ; DGRSLT - 0 = veteran too young
182 ; 1 = veteran old enough
183 ;
184 N DFN,VA,VADM,VAERR ;DEM^VADPT variables
185 N DGDOB
186 N DGRSLT
187 S DGDFN=+$G(DGDFN)
188 S DGDATE=+$G(DGDATE)
189 S DGRSLT=1
190 S DFN=DGDFN
191 D DEM^VADPT
192 S DGDOB=+$G(VADM(3))
193 I DGDATE-DGDOB\10000<15 S DGRSLT=0
194 Q DGRSLT
195 ;
Note: See TracBrowser for help on using the repository browser.