source: FOIAVistA/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDFN.m@ 1783

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

initial load of FOIAVistA 6/30/08 version
File size: 7.0 KB
Line 
1IBDFN ;ALB/CJM - ENCOUNTER FORM - INTERFACE ROUTINES ;NOV 16,1992
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;**11,36**;APR 24, 1997
3VADPT ;returns patient demographic data
4 ;input variables - DFN
5 N ARY
6 S ARY="^TMP(""IB"",$J,""INTERFACES"",+$G(DFN))"
7 D DEM^VADPT
8 I VAERR S (@ARY@("DPT PATIENT'S NAME"),@ARY@("DPT PATIENT'S DOB/AGE"),@ARY@("DPT PATIENT'S SEX"),@ARY@("DPT PATIENT'S PID"),@ARY@("DPT PATIENT'S MARITAL STATUS"))="" Q
9 S @ARY@("DPT PATIENT'S NAME")=VADM(1),@ARY@("DPT PATIENT'S SEX")=$P(VADM(5),"^",2)_"^"_$E($P(VADM(5),"^",2)),@ARY@("DPT PATIENT'S DOB/AGE")=$P(VADM(3),"^",2)_"^"_VADM(4),@ARY@("DPT PATIENT'S PID")=VA("PID")
10 S @ARY@("DPT PATIENT'S MARITAL STATUS")=$P(VADM(10),"^",2)
11 S @ARY@("DPT PATIENT'S RACE")=$P(VADM(8),"^",2)
12 S @ARY@("DPT PATIENT'S REMARKS")=$P($G(^DPT(+$G(DFN),0)),"^",10)
13 K VADM,VA,VAERR,VAEL
14 Q
15EMPLMNT ;returns patient's employment status
16 ;input variables - DFN
17 D OPD^VADPT
18 I VAERR S @IBARY="" Q
19 S @IBARY=$P(VAPD(7),"^",2)
20 K VAPD,VA,VAERR,VAEL
21 Q
22 ;
23DATE(Y) ; Y=date in FM form, this function translates the date to its
24 ;external form
25 D DD^%DT
26 Q Y
27 Q
28 ;
29ELIG ;for output of eligibility information & service connected conditions
30 N COUNT,ARY,VAEL,VAERR,NODE0,COND,DESCR,PERC,EC,VASV,DATA,I,SARY
31 S ARY="^TMP(""IB"",$J,""INTERFACES"",+$G(DFN))"
32 S SARY="^TMP(""IB"",$J,""INTERFACES"")"
33 D ELIG^VADPT
34 I VAERR F I=1:1:6 S VAEL(I)=""
35 S PERC=$P(VAEL(3),"^",2),PERC=$S(PERC="":"",1:$J(PERC,3,0))
36 S @ARY@("DPT PATIENT ELIGIBILITY DATA")=$P(VAEL(1),"^",2)_"^"_$P(VAEL(2),"^",2)_"^"_$S(VAEL(3):"YES",VAEL(3)=0:"NO",1:"")_"^"_$S(VAEL(4):"YES",VAEL(4)=0:"NO",1:"")_"^"_$S(VAEL(5):"YES",VAEL(5)=0:"NO",1:"")_"^"_$P(VAEL(6),"^",2)_"^"_PERC
37 S @ARY@("DPT SC HIDDEN LABELS")=$S(((+VAEL(3))!($O(^DPT(DFN,.372,0)))):"%^% - SERVICE CONNECTED^SERVICE CONNECTED:^SC CONDITIONS:^S/C",1:" ^ ^ ^ ^ ")
38 I $O(^DPT(DFN,.372,0)),VAEL(4)!$$GET1^DIQ(391,+VAEL(6),.02) S (COUNT,COND)=0 F S COND=$O(^DPT(DFN,.372,COND)) Q:COND="" D
39 .S NODE0=$G(^DPT(DFN,.372,COND,0)) Q:'$P(NODE0,"^",3) S DESCR=$G(^DIC(31,+NODE0,0)),COUNT=COUNT+1
40 .S PERC=$P(NODE0,"^",2),PERC=$S(PERC="":"",1:$J(PERC,3,0))
41 .S @SARY@("DPT PATIENT'S SC CONDITIONS",COUNT)=$S($P(DESCR,"^",4)'="":$P(DESCR,"^",4),1:$P(DESCR,"^",1))_"^"_PERC_"^"_PERC_"%"_"^"_PERC_"%SC"_"^"_PERC_"% - SERVICE CONNECTED"
42 ;
43 ;get service data
44 D SVC^VADPT
45 I VAERR S DATA="^^^^"
46 E S DATA=$S(VASV(1):"YES",1:"NO")_"^"_$S(VASV(2):"YES",1:"NO")_"^"_$S(VASV(3):"YES",1:"NO")_"^"_$S(VASV(4):"YES",1:"NO")_"^"_$S(VASV(5):"YES",1:"NO")
47 ;
48 ;get the persian gulf indicator - not returned by VADPT
49 S EC=$$EC^SDCO22(DFN,0)
50 ;S EC=$P($G(^DPT(DFN,.322)),"^",13)
51 S @ARY@("DPT SERVICE HISTORY RELATED DATA")=DATA_"^"_$S(EC=1:"YES",1:"NO")
52 ;
53 ;displays questions concerning treatment related to service only
54 ;if they apply
55 ;
56 S DATA=$S(VAEL(3):"Was treatment for a SC condition? __ YES __ NO",1:"")_"^"
57 S DATA=DATA_$S(VASV(2):"Was treatment related to exposure to Agent Orange? __ YES __ NO",1:"")_"^"
58 S DATA=DATA_$S(VASV(3):"Was treatment related to exposure to Ionization Radiation? __ YES __ NO",1:"")
59 S @ARY@("DPT SC TREATMENT QUESTIONS")=DATA
60 ;
61 ;note: must store the 4th question in an annex node
62 S DATA="^^^"_$S(EC=1:"Was treatment related to exposure to Environmental Contaminants? __ YES __ NO",1:"")_"^"
63 I VASV(2)!VASV(3)!(EC=1) D
64 .S DATA=DATA_"Was treatment related to: "_$S(VASV(2):"AO __ ",1:"")_$S(VASV(3):"IR __ ",1:"")_$S(EC=1:"EC __ ",1:"")
65 S @ARY@("DPT SC TREATMENT QUESTIONS",1)=DATA
66 Q
67 ;
68BLANKS ;returns NOTHING for printing blank lines
69 S @IBARY=""
70 Q
71LABELS ;returns NOTHING for printing labels only, ie, no data
72 S @IBARY=""
73 Q
74ELIG1 ;for output of hidden service connected conditions
75 N COUNT,ARY,VAEL,VAERR,VASV,EC
76 S ARY="^TMP(""IB"",$J,""INTERFACES"")",COUNT=0
77 D ELIG^VADPT
78 I 'VAERR,(VAEL(3)) S COUNT=COUNT+1,@ARY@("DPT SC HIDDEN TREATMENT QUESTIONS",COUNT)="SC^Was treatment for an SC condition?"
79 ;
80 ;get service data
81 D SVC^VADPT
82 I 'VAERR D
83 .I VASV(2) S COUNT=COUNT+1,@ARY@("DPT SC HIDDEN TREATMENT QUESTIONS",COUNT)="AO^Was treatment related to exposure to Agent Orange?"
84 .I VASV(3) S COUNT=COUNT+1,@ARY@("DPT SC HIDDEN TREATMENT QUESTIONS",COUNT)="IR^Was treatment related to exposure to Ionization Radiation?"
85 ;
86 ;get the persian gulf indicator - not returned by VADPT
87 ;S EC=$P($G(^DPT(DFN,.322)),"^",13)
88 I $$EC^SDCO22(DFN,0) S COUNT=COUNT+1,@ARY@("DPT SC HIDDEN TREATMENT QUESTIONS",COUNT)="EC^Was treatment related to exposure to Environmental Contaminants?"
89 Q
90 ;
91ELIG2 ; -- for output of hidden classification questions
92 N COUNT,ARY
93 I $G(IBCLINIC) I '$$REQ^IBDFDE0(DFN,IBAPPT,IBCLINIC,0) Q
94 ;
95 S ARY="^TMP(""IB"",$J,""INTERFACES"")",COUNT=0
96 ;
97 I $$SC^SDCO22(DFN,0) D SETARY(ARY,.COUNT,"SC^Was treatment for an SC condition?")
98 I $$AO^SDCO22(DFN,0) D SETARY(ARY,.COUNT,"AO^Was treatment related to exposure to Agent Orange?")
99 I $$IR^SDCO22(DFN,0) D SETARY(ARY,.COUNT,"IR^Was treatment related to exposure to Ionization Radiation?")
100 I $$EC^SDCO22(DFN,0) D SETARY(ARY,.COUNT,"EC^Was treatment related to exposure to Environmental Contaminants?")
101 ;
102ELIG2Q Q
103 ;
104SETARY(ARY,CNT,TEXT) ; -- build array
105 S CNT=CNT+1
106 S @ARY@("DPT SC HIDDEN TREATMENT QUESTIONS",CNT)=TEXT
107 Q
108 ;
109ELIGMST ;-- Adds the MST indicator to existing hidden classification questions
110 ; (patch IBD*3*36)
111 ;
112 N ARY,DATA,MST,MSTSTAT
113 D ELIG
114 S ARY="^TMP(""IB"",$J,""INTERFACES"",+$G(DFN))"
115 S MST=$$MST^SDCO22(DFN,0)
116 S MSTSTAT=$P($$GETSTAT^DGMSTAPI(DFN),"^",2),MSTSTAT=$S(MSTSTAT="Y":"YES",MSTSTAT="N":"NO",MSTSTAT="U":"UNKNOWN",MSTSTAT="D":"DECLINED",1:"")
117 I $D(@ARY@("DPT SERVICE HISTORY RELATED DATA")) S @ARY@("DPT SERVICE HISTORY RELATED DATA (MST)")=$G(@ARY@("DPT SERVICE HISTORY RELATED DATA"))_"^"_MSTSTAT
118 ;
119 I $D(@ARY@("DPT SC TREATMENT QUESTIONS")) S @ARY@("DPT SC TREATMENT QUESTIONS (MST)")=$G(@ARY@("DPT SC TREATMENT QUESTIONS"))
120 I $D(@ARY@("DPT SC TREATMENT QUESTIONS",1)) D
121 . S DATA=$G(@ARY@("DPT SC TREATMENT QUESTIONS",1))
122 . I MST D
123 .. S DATA=DATA_$S($L($P(DATA,"^",5))>1:"MST __",1:"Was treatment related to: MST __")
124 .. S $P(DATA,"^",6)=$S(MST:"Was treatment related to MST? __ YES __ NO",1:"")
125 . S @ARY@("DPT SC TREATMENT QUESTIONS (MST)",1)=DATA
126 Q
127 ;
128ELIG1MST ;-- Similar to ELIG1 but adds MST indicator (if applicable) to hidden classification questions array
129 ;
130 K ^TMP("IB",$J,"INTERFACES","DPT SC HIDDEN TREATMENT QUESTIONS")
131 K ^TMP("IB",$J,"INTERFACES","DPT SC HIDDEN TREATMENT QUESTIONS (MST)")
132 D ELIG1
133 D ELIGSET
134 Q
135 ;
136ELIG2MST ;-- Similar to ELIG2 but adds MST indicator (if applicable) to hidden classification questions array
137 ;
138 K ^TMP("IB",$J,"INTERFACES","DPT SC HIDDEN TREATMENT QUESTIONS")
139 K ^TMP("IB",$J,"INTERFACES","DPT SC HIDDEN TREATMENT QUESTIONS (MST)")
140 D ELIG2
141 D ELIGSET
142 Q
143 ;
144ELIGSET ;-- Checks for MST and adds MST question to hidden classification array
145 ;
146 N ARY,COUNT,I
147 S ARY="^TMP(""IB"",$J,""INTERFACES"")"
148 S (COUNT,I)=0
149 M @ARY@("DPT SC HIDDEN TREATMENT QUESTIONS (MST)")=@ARY@("DPT SC HIDDEN TREATMENT QUESTIONS")
150 I $$MST^SDCO22(DFN,0) D
151 . F S I=$O(@ARY@("DPT SC HIDDEN TREATMENT QUESTIONS (MST)",I)) Q:'I S COUNT=I
152 . S COUNT=COUNT+1,@ARY@("DPT SC HIDDEN TREATMENT QUESTIONS (MST)",COUNT)="MST^Was treatment related to MST? (Ask provider only)"
153 Q
Note: See TracBrowser for help on using the repository browser.