1 | GMTSDEM ; SLC/DLT,KER - Demographics ; 12/11/2002
|
---|
2 | ;;2.7;Health Summary;**28,49,55,56,60,73**;Oct 20, 1995
|
---|
3 | ;
|
---|
4 | ; External References
|
---|
5 | ; DBIA 10061 OAD^VADPT
|
---|
6 | ; DBIA 10061 OPD^VADPT
|
---|
7 | ; DBIA 10061 SVC^VADPT
|
---|
8 | ; DBIA 10061 ADD^VADPT
|
---|
9 | ; DBIA 10061 DEM^VADPT
|
---|
10 | ; DBIA 10061 ELIG^VADPT
|
---|
11 | ; DBIA 2967 ^DIC(31,
|
---|
12 | ; DBIA 10035 ^DPT( (file #2)
|
---|
13 | ;
|
---|
14 | DEMOG ; Demographic (VADPT)
|
---|
15 | N I,VA,VADM,VAERR,VAOA,VASV,VAPA,VAPD,VAEL,SCD,SCDS,SCDP,FROM,GMI,TO,IX,X,Z
|
---|
16 | D ADR,PER,SVC,BOS,COMB,ELIG,SC,SCDD,MT
|
---|
17 | D NOK^GMTSDEM2,CD^GMTSDEMP(+($G(DFN)))
|
---|
18 | D INS^GMTSDEM2,TF^GMTSDEMB(+($G(DFN)))
|
---|
19 | D SRC^GMTSDEMB,END
|
---|
20 | Q
|
---|
21 | DEMO(DFN) ;
|
---|
22 | K ^TMP("GMTSDEMO",$J,+($G(DFN)))
|
---|
23 | N GMTSDEMX,I,VA,VADM,VAERR,VAOA,VASV,VAPA,VAPD,VAEL,SCD,SCDS,SCDP,FROM,GMI,TO,IX,X,Z
|
---|
24 | S GMTSDEMX="" D DEMOG D:$D(GMTSTEST) ST
|
---|
25 | Q
|
---|
26 | ADR ; Patient Address
|
---|
27 | Q:$D(GMTSQIT) D:$D(GMTSDEMX) NAM Q:$D(GMTSQIT) N %,%H,VA,VAPA,VAERR D ADD^VADPT
|
---|
28 | D WRT("Address",$S($L(VAPA(1)):VAPA(1),1:"Not available"),"Phone",VAPA(8),1) Q:$D(GMTSQIT)
|
---|
29 | I VAPA(2)'="" D WRT(($J("",21)_VAPA(2)),,,,0) Q:$D(GMTSQIT)
|
---|
30 | I VAPA(3)'="" D WRT(($J("",21)_VAPA(3)),,,,0) Q:$D(GMTSQIT)
|
---|
31 | I VAPA(4)'="" D Q:$D(GMTSQIT)
|
---|
32 | . N STR S STR=VAPA(4)_", " S:VAPA(5)'="" STR=STR_$P($G(VAPA(5)),"^",2)_" "
|
---|
33 | . S:VAPA(6)'="" STR=STR_VAPA(6) D WRT("",STR,"County",$P(VAPA(7),"^",2),1)
|
---|
34 | D WRT(" ",,,,0)
|
---|
35 | Q
|
---|
36 | NAM ; Name/SSN/DOB/Sex
|
---|
37 | N VAPTYP,VAHOW,VAROUT,VADM D DEM^VADPT
|
---|
38 | D WRT("Name",$G(VADM(1)),"SSN",$E($P($G(VADM(2)),"^",2),1,11),1)
|
---|
39 | D WRT("Date of Birth",$$EDT^GMTSU($P($G(VADM(3)),"^",1)),,,1)
|
---|
40 | Q
|
---|
41 | PER ; Personal
|
---|
42 | Q:$D(GMTSQIT) N %,%H,VA,VADM,VAERR,VAPD D DEM^VADPT,OPD^VADPT
|
---|
43 | I VADM(10)'=""!(VADM(4)'="") D Q:$D(GMTSQIT)
|
---|
44 | . D WRT("Marital Status",$P($G(VADM(10)),"^",2),"Age",$P($G(VADM(4)),"^",1),1)
|
---|
45 | I VADM(9)'=""!(VADM(5)'="") D Q:$D(GMTSQIT)
|
---|
46 | . D WRT("Religion",$P($G(VADM(9)),"^",2),"Sex",$P($G(VADM(5)),"^",2),1)
|
---|
47 | D RACE^GMTSDEM2 I VAPD(6)'="" D Q:$D(GMTSQIT)
|
---|
48 | . D WRT("Occupation",$P($G(VAPD(6)),"^",1),,,1)
|
---|
49 | Q
|
---|
50 | SVC ; Service
|
---|
51 | Q:$D(GMTSQIT) N %,%H,VAEL,VAERR D ELIG^VADPT
|
---|
52 | I $P(VAEL(2),"^",1) D Q:$D(GMTSQIT)
|
---|
53 | . D WRT("Period of Service",$P($G(VAEL(2)),"^",2),,,1)
|
---|
54 | Q
|
---|
55 | BOS ; Branch of Service
|
---|
56 | Q:$D(GMTSQIT) N %,%H,VAEL,VAERR,VASV,GMTSI,FROM,TO
|
---|
57 | D SVC^VADPT F GMTSI=6,7,8 D
|
---|
58 | . Q:'$D(VASV(GMTSI)) Q:+(VASV(GMTSI))=0
|
---|
59 | . S FROM=$$EDT^GMTSU($P(VASV(GMTSI,4),U,1))
|
---|
60 | . S TO=$$EDT^GMTSU($P(VASV(GMTSI,5),U,1))
|
---|
61 | . S:$L(FROM)&('$L(TO)) TO="UNKNOWN"
|
---|
62 | . D:GMTSI=6 WRT("Branch of Service",($P(VASV(GMTSI,1),U,2)_" "_FROM_" TO "_TO),,,1)
|
---|
63 | . D:GMTSI'=6 WRT("",($P(VASV(GMTSI,1),U,2)_" "_FROM_" TO "_TO),,,1)
|
---|
64 | Q
|
---|
65 | COMB ; Service Connected Disabilities
|
---|
66 | Q:$D(GMTSQIT) N %,%H,VAEL,VAERR,VASV D ELIG^VADPT,SVC^VADPT
|
---|
67 | I $P(VAEL(2),U) D Q:$D(GMTSQIT)
|
---|
68 | . D WRT("Combat",$S(VASV(5):"YES",1:"NO"),"POW",$S(VASV(4):"YES",1:"NO"),1)
|
---|
69 | Q
|
---|
70 | ELIG ; Eligibility
|
---|
71 | Q:$D(GMTSQIT) N Z,I,%,%H,VAEL,VAERR D ELIG^VADPT
|
---|
72 | I $P(VAEL(1),"^",1) D Q:$D(GMTSQIT)
|
---|
73 | . D WRT("Eligibility",$P(VAEL(1),"^",2),$S(VAEL(8)'="":"Status",1:""),$P(VAEL(8),"^",2),1)
|
---|
74 | I $O(VAEL(1,0)) D Q:$D(GMTSQIT)
|
---|
75 | . S I=0 F Z=0:0 D Q:$D(GMTSQIT) Q:I=""
|
---|
76 | . . Q:$D(GMTSQIT) S I=$O(VAEL(1,I)) Q:I=""
|
---|
77 | . . D WRT("",$P(VAEL(1,I),"^",2),,,1)
|
---|
78 | Q
|
---|
79 | SC ; Service Connected Percent
|
---|
80 | Q:$D(GMTSQIT) N %,%H,VAEL,VAERR D ELIG^VADPT
|
---|
81 | D:VAEL(3) WRT("S/C %",$P(VAEL(3),"^",2),,,1)
|
---|
82 | Q
|
---|
83 | SCDD ; Service Connected Disabilities/Diagnosis
|
---|
84 | Q:$D(GMTSQIT) N SCD,SCDP,SCDS,IX,GMTSC S (IX,GMTSC)=0
|
---|
85 | F S IX=$O(^DPT(DFN,.372,IX)) Q:$D(GMTSQIT) Q:+IX=0 D SCDP Q:$D(GMTSQIT)
|
---|
86 | Q
|
---|
87 | SCDP ; Service Connected Diagnosis
|
---|
88 | Q:$D(GMTSQIT) N SCD,SCDS,SCDP S SCD=^DPT(DFN,.372,IX,0)
|
---|
89 | S SCDS=$S($P(SCD,"^",1):$P(^DIC(31,$P(SCD,"^",1),0),"^",1),1:"")
|
---|
90 | S SCDP=$P(SCD,"^",2)_"% "_$S($P(SCD,"^",3):"SC",1:"")
|
---|
91 | S GMTSC=+($G(GMTSC))+1
|
---|
92 | I +($G(GMTSC))'>1 D Q:$D(GMTSQIT)
|
---|
93 | . S STR=" S/C Disabilities: "_SCDS,STR=STR_$J("",(61-$L(STR)))_SCDP
|
---|
94 | . D WRT(STR,,,,0)
|
---|
95 | I +($G(GMTSC))>1 D
|
---|
96 | . S STR=$J("",21)_SCDS,STR=STR_$J("",(61-$L(STR)))_SCDP
|
---|
97 | . D WRT(STR,,,,0)
|
---|
98 | Q
|
---|
99 | MT ; Means Test
|
---|
100 | Q:$D(GMTSQIT) N %,%H,VAEL,VAERR D ELIG^VADPT
|
---|
101 | D:VAEL(9)'="" WRT("Means Test",$P(VAEL(9),"^",2),,,1)
|
---|
102 | Q
|
---|
103 | NOK ; Next of Kin
|
---|
104 | Q:$D(GMTSQIT) N %,%H,VAOA S VAOA("A")=1 D OAD^VADPT
|
---|
105 | Q:VAOA(9)="" I VAOA(9)'="" D Q:$D(GMTSQIT)
|
---|
106 | . D CKP^GMTSUP Q:$D(GMTSQIT)
|
---|
107 | . W ?16,"NOK: ",VAOA(9)
|
---|
108 | . W:VAOA(10)'="" ?51,"Relation: ",VAOA(10) W !
|
---|
109 | I VAOA(1)'="" D Q:$D(GMTSQIT)
|
---|
110 | . D CKP^GMTSUP Q:$D(GMTSQIT)
|
---|
111 | . W:VAOA(1)]"" ?21,VAOA(1)
|
---|
112 | . W:VAOA(8)'="" ?54,"Phone: ",VAOA(8) W !
|
---|
113 | I VAOA(2)'="" D Q:$D(GMTSQIT)
|
---|
114 | . D CKP^GMTSUP Q:$D(GMTSQIT) W ?21,VAOA(2),!
|
---|
115 | I VAOA(3)'="" D Q:$D(GMTSQIT)
|
---|
116 | . D CKP^GMTSUP Q:$D(GMTSQIT) W ?21,VAOA(3),!
|
---|
117 | I VAOA(4)'="" D Q:$D(GMTSQIT)
|
---|
118 | . D CKP^GMTSUP Q:$D(GMTSQIT)
|
---|
119 | . W ?21,VAOA(4) W:VAOA(5) ", ",$P(VAOA(5),U,2)
|
---|
120 | . W:VAOA(6) " ",VAOA(6) W !
|
---|
121 | Q
|
---|
122 | IEN ; Ineligible for Care Data
|
---|
123 | Q:$D(GMTSQIT) N STR,REM,WRD,%,%H,VAEL,VAERR,GMTSDT D ELIG^VADPT
|
---|
124 | I +($P(VAEL(5,1),U,1))>0 D
|
---|
125 | . S GMTSDT=$$EDT^GMTSU($P(VAEL(5,1),U,1))
|
---|
126 | . Q:$D(GMTSQIT) D WRT("Ineligible date",GMTSDT,,,1)
|
---|
127 | . Q:$D(GMTSQIT) S STR=$P(VAEL(5,2),U,2)_" "_VAEL(5,3)_", "_$P(VAEL(5,4),U,2)
|
---|
128 | . D WRT("Inelig. TWX source",STR,,,1)
|
---|
129 | . Q:$D(GMTSQIT) S STR=$G(VAEL(5,5))
|
---|
130 | . F WRD=1:1 Q:$L(STR)'>58 D
|
---|
131 | . . S REM=$P(STR," ",($L(STR," ")-WRD),$L(STR," "))
|
---|
132 | . . S STR=$P(STR," ",1,($L(STR," ")-(WRD+1)))
|
---|
133 | . D:$L(STR) WRT(($J("",21)_STR),,,,0)
|
---|
134 | . D:$L(REM) WRT(($J("",21)_REM),,,,0)
|
---|
135 | . D:$L(VAEL(5,6)) WRT("Reason",$E(VAEL(5,6),1,58),,,1)
|
---|
136 | Q
|
---|
137 | ;
|
---|
138 | WRT(CH1,CD1,CH2,CD2,FMT) ; Write/Save Demographic Line
|
---|
139 | ;
|
---|
140 | ; Input
|
---|
141 | ; CH1 - Column 1 Header or Preformated Line
|
---|
142 | ; CD1 - Column 1 Data
|
---|
143 | ; CH2 - Column 2 Header
|
---|
144 | ; CD2 - Column 2 Data
|
---|
145 | ; FMT - Format in Columns 1=Yes 0=No
|
---|
146 | ;
|
---|
147 | ; If the variable GMTSDEMX exist, then the data will
|
---|
148 | ; be saved in a global array instead of written to the
|
---|
149 | ; screen. Global array:
|
---|
150 | ;
|
---|
151 | ; ^TMP("GMTSDEMO",$J,DFN,#)=<demographic text>
|
---|
152 | Q:$D(GMTSQIT) N STR,BL,COL1,COL2,LN,LNLGTH
|
---|
153 | S LN=+($O(^TMP("GMTSDEMO",$J,+($G(DFN))," "),-1))+1,CH1=$G(CH1),CD1=$G(CD1),CH2=$G(CH2),CD2=$G(CD2),FMT=$G(FMT)
|
---|
154 | S:+FMT'>0 STR=CH1
|
---|
155 | I +FMT>0 D
|
---|
156 | . S LNLGTH=59
|
---|
157 | . S:CH2="" LNLGTH=78
|
---|
158 | . S BL=$J("",(19-$L(CH1))),CH1=BL_CH1_$S($L(CH1)>0:": ",1:" ")
|
---|
159 | . S BL=$J("",(((LNLGTH-$L(CH1))-$L(CH2))-2))
|
---|
160 | . S CD1=$E(CD1,1,$L(BL)),COL1=CH1_CD1
|
---|
161 | . S BL=$J("",((59-$L(COL1))-$L(CH2)))
|
---|
162 | . S CH2=BL_CH2_$S($L(CH2)>0:": ",1:" "),COL2=CH2_$E(CD2,1,17)
|
---|
163 | . S STR=COL1_COL2
|
---|
164 | I '$D(GMTSDEMX) D CKP^GMTSUP Q:$D(GMTSQIT) W $G(STR),!
|
---|
165 | S:$D(GMTSDEMX) ^TMP("GMTSDEMO",$J,+($G(DFN)),LN)=STR
|
---|
166 | Q
|
---|
167 | ;
|
---|
168 | ST ; Show ^TMP Global Array
|
---|
169 | W !! N NN,NC S NN="^TMP(""GMTSDEMO"","_$J_","_+($G(DFN))_")",NC="^TMP(""GMTSDEMO"","_$J_","_+($G(DFN))_"," F S NN=$Q(@NN) Q:NN=""!(NN'[NC) W !,@NN
|
---|
170 | Q
|
---|
171 | END ; Clean-up and quit
|
---|
172 | K I,VA,VADM,VAERR,VAOA,VASV,VAPA,VAPD,VAEL,SCD,SCDS,SCDP,FROM
|
---|
173 | K GMI,TO,IX,X,Z Q
|
---|