[613] | 1 | VAFHLZPD ;ALB/KCL/PHH,TDM - Create generic HL7 ZPD segment ; 7/24/06 10:05am
|
---|
| 2 | ;;5.3;Registration;**94,122,160,220,247,545,564,568,677,653**;Aug 13, 1993;Build 2
|
---|
| 3 | ;
|
---|
| 4 | ;
|
---|
| 5 | EN(DFN,VAFSTR) ; This generic extrinsic function was designed to return
|
---|
| 6 | ; sequences 1 throught 21 of the HL7 ZPD segment. This segment
|
---|
| 7 | ; contains VA-specific patient information that is not contained in
|
---|
| 8 | ; the HL7 PID segment. This call does not accomodate a segment
|
---|
| 9 | ; length greater than 245 and has been superceeded by EN1^VAFHLZPD.
|
---|
| 10 | ; This line tag has been left for backwards compatability.
|
---|
| 11 | ;
|
---|
| 12 | ;Input - DFN as internal entry number of the PATIENT file
|
---|
| 13 | ; - VAFSTR as the string of fields requested seperated by commas
|
---|
| 14 | ; (Defaults to all fields)
|
---|
| 15 | ;
|
---|
| 16 | ; *****Also assumes all HL7 variables returned from*****
|
---|
| 17 | ; INIT^HLTRANS are defined.
|
---|
| 18 | ;
|
---|
| 19 | ;Output - String of data forming the ZPD segment.
|
---|
| 20 | ;
|
---|
| 21 | ;
|
---|
| 22 | N VAFY,VAFZPD,REMARKS
|
---|
| 23 | S VAFY=$$EN1($G(DFN),$G(VAFSTR))
|
---|
| 24 | ;Segment less than 245 characters
|
---|
| 25 | I ('$D(VAFZPD(1))) D
|
---|
| 26 | .;Remove sequences 22 and higher
|
---|
| 27 | .S VAFY=$P(VAFY,HLFS,1,22)
|
---|
| 28 | ;Segment greater than 245 characters
|
---|
| 29 | I ($D(VAFZPD(1))) D
|
---|
| 30 | .;Strip out REMARKS (seq 2)
|
---|
| 31 | .S REMARKS=$P(VAFY,HLFS,3)
|
---|
| 32 | .S $P(VAFY,HLFS,3)=""
|
---|
| 33 | .;Append up to sequence 21 (PRIMARY CARE TEAM)
|
---|
| 34 | .S VAFY=VAFY_$P(VAFZPD(1),HLFS,1,((21-$L(VAFY,HLFS))+2))
|
---|
| 35 | .;Place REMARKS back into segment, truncating if needed
|
---|
| 36 | .S $P(VAFY,HLFS,3)=$E(REMARKS,1,(245-$L(VAFY)))
|
---|
| 37 | ;Done
|
---|
| 38 | Q VAFY
|
---|
| 39 | ;
|
---|
| 40 | EN1(DFN,VAFSTR) ; This generic extrinsic function was designed to return the
|
---|
| 41 | ; HL7 ZPD segment. This segment contains VA-specific patient
|
---|
| 42 | ; information that is not contained in the HL7 PID segment. This
|
---|
| 43 | ; call superceeds EN^VAFHLZPD because it accomodates a segment
|
---|
| 44 | ; length greater than 245.
|
---|
| 45 | ;
|
---|
| 46 | ;
|
---|
| 47 | ;Input : DFN - Pointer to PATIENT file (#2)
|
---|
| 48 | ; VAFSTR - List of data elements to retrieve seperated
|
---|
| 49 | ; by commas (ex: 1,2,3)
|
---|
| 50 | ; - Defaults to all data elements
|
---|
| 51 | ; Existance of HL7 encoding variables is assumed
|
---|
| 52 | ; (HLFS, HLENC, HLQ)
|
---|
| 53 | ;Output : ZPD segment
|
---|
| 54 | ; : If the ZPD segment becomes longer than 245 characters,
|
---|
| 55 | ; remaining fields will be placed in VAFZPD(1)
|
---|
| 56 | ;Notes : Sequence 1 (Set ID) will always have a value of '1'
|
---|
| 57 | ; : A ZPD segment with sequence one set to '1' will be returned
|
---|
| 58 | ; if DFN is not valid
|
---|
| 59 | ; : Variable VAFZPD is initialized on entry
|
---|
| 60 | ;
|
---|
| 61 | ;Declare variables
|
---|
| 62 | N VAFHLZPD,VAFY,SEQ,SPILL,SPILLON,SPOT,LASTSEQ,MAXLEN
|
---|
| 63 | K VAFZPD
|
---|
| 64 | S MAXLEN=245
|
---|
| 65 | ;Get data
|
---|
| 66 | D GETDATA($G(DFN),$G(VAFSTR),"VAFHLZPD")
|
---|
| 67 | ;Build segment
|
---|
| 68 | S VAFY="VAFHLZPD"
|
---|
| 69 | S SPILL=0
|
---|
| 70 | S SPILLON=0
|
---|
| 71 | S @VAFY="ZPD"
|
---|
| 72 | S LASTSEQ=+$O(VAFHLZPD(""),-1)
|
---|
| 73 | F SEQ=1:1:LASTSEQ D
|
---|
| 74 | .;Make sure maximum length won't be exceeded
|
---|
| 75 | .I ($L(@VAFY)+$L($G(VAFHLZPD(SEQ)))+1)>MAXLEN D
|
---|
| 76 | ..;Max length exceeded - start putting data on next node
|
---|
| 77 | ..S SPILL=SPILL+1
|
---|
| 78 | ..S SPILLON=SEQ-1
|
---|
| 79 | ..S VAFY=$NA(VAFZPD(SPILL))
|
---|
| 80 | .;Add to string
|
---|
| 81 | .S SPOT=(SEQ+1)-SPILLON
|
---|
| 82 | .S $P(@VAFY,HLFS,SPOT)=$G(VAFHLZPD(SEQ))
|
---|
| 83 | ;Return segment
|
---|
| 84 | Q VAFHLZPD
|
---|
| 85 | ;
|
---|
| 86 | GETDATA(DFN,VAFSTR,ARRAY) ;Get info needed to build segment
|
---|
| 87 | ;Input : DFN - Pointer to PATIENT file (#2)
|
---|
| 88 | ; VAFSTR - List of data elements to retrieve seperated
|
---|
| 89 | ; by commas (ex: 1,2,3)
|
---|
| 90 | ; - Defaults to all data elements
|
---|
| 91 | ; ARRAY - Array to return data in (full global reference)
|
---|
| 92 | ; Defaults to ^TMP($J,"VAFHLZPD")
|
---|
| 93 | ; Existance of HL7 encoding variables is assumed
|
---|
| 94 | ; (HLFS, HLENC, HLQ)
|
---|
| 95 | ;Output : Nothing
|
---|
| 96 | ; ARRAY(SeqNum) = Value
|
---|
| 97 | ;Notes : ARRAY is initialized (KILLed) on entry
|
---|
| 98 | ; : Sequence 1 (Set ID) will always have a value of '1'
|
---|
| 99 | ;
|
---|
| 100 | ;Check input
|
---|
| 101 | S ARRAY=$G(ARRAY)
|
---|
| 102 | S:(ARRAY="") ARRAY=$NA(^TMP($J,"VAFHLZPD"))
|
---|
| 103 | K @ARRAY
|
---|
| 104 | ;Sequence 1 - Set ID
|
---|
| 105 | ; value is always '1'
|
---|
| 106 | S @ARRAY@(1)=1
|
---|
| 107 | S DFN=+$G(DFN)
|
---|
| 108 | S VAFSTR=$G(VAFSTR)
|
---|
| 109 | S:(VAFSTR="") VAFSTR=$$COMMANUM(1,40)
|
---|
| 110 | S VAFSTR=","_VAFSTR_","
|
---|
| 111 | ;Declare variables
|
---|
| 112 | N VAFNODE,VAPD,X1,X
|
---|
| 113 | ;Get zero node
|
---|
| 114 | S VAFNODE=$G(^DPT(DFN,0))
|
---|
| 115 | ;Get other patient data from VADPT
|
---|
| 116 | D OPD^VADPT
|
---|
| 117 | ;Sequence 2 - Remarks (truncate to 60 characters)
|
---|
| 118 | I VAFSTR[",2," S X=$P(VAFNODE,"^",10),@ARRAY@(2)=$S(X="":HLQ,1:$E(X,1,60))
|
---|
| 119 | ;Sequence 3 - Place of birth (city)
|
---|
| 120 | I VAFSTR[",3," S @ARRAY@(3)=$S(VAPD(1)]"":VAPD(1),1:HLQ)
|
---|
| 121 | ;Sequence 4 - Place of birth (State abbrv.)
|
---|
| 122 | I VAFSTR[",4," S X1=$P($G(^DIC(5,$P(+VAPD(2),"^",1),0)),"^",2),@ARRAY@(4)=$S(X1]"":X1,1:HLQ)
|
---|
| 123 | ;Sequence 5 - Current means test status
|
---|
| 124 | I VAFSTR[",5," S X=$P(VAFNODE,"^",14),X1=$P($G(^DG(408.32,+X,0)),"^",2),@ARRAY@(5)=$S(X1]"":X1,1:HLQ)
|
---|
| 125 | ;Sequence 6 - Fathers name
|
---|
| 126 | I VAFSTR[",6," S @ARRAY@(6)=$S(VAPD(3)]"":VAPD(3),1:HLQ)
|
---|
| 127 | ;Sequence 7 - Mothers name
|
---|
| 128 | I VAFSTR[",7," S @ARRAY@(7)=$S(VAPD(4)]"":VAPD(4),1:HLQ)
|
---|
| 129 | ;Sequence 8 - Rated incompetent
|
---|
| 130 | I VAFSTR[",8," S X1=$$YN^VAFHLFNC($P($G(^DPT(DFN,.29)),"^",12)),@ARRAY@(8)=$S(X1]"":X1,1:HLQ)
|
---|
| 131 | ;Sequence 9 - Date of Death
|
---|
| 132 | I VAFSTR[",9," S X=$P($G(^DPT(DFN,.35)),"^",1),X1=$$HLDATE^HLFNC(X),@ARRAY@(9)=$S(X1]"":X1,1:HLQ)
|
---|
| 133 | ;Sequence 10 - Collateral sponser name
|
---|
| 134 | I VAFSTR[10 D
|
---|
| 135 | .S X=$P($G(^DPT(DFN,.36)),"^",11)
|
---|
| 136 | .S X1=$P($G(^DPT(+X,0)),"^",1)
|
---|
| 137 | .S @ARRAY@(10)=$S(X1]"":X1,1:HLQ)
|
---|
| 138 | ;Sequence 11 - Active Health Insurance?
|
---|
| 139 | I VAFSTR[11 S X=$$INS^VAFHLFNC(DFN),X1=$$YN^VAFHLFNC(X),@ARRAY@(11)=$S(X1]"":X1,1:HLQ)
|
---|
| 140 | ;Sequences 12 & 13
|
---|
| 141 | I VAFSTR[12!(VAFSTR[13) D
|
---|
| 142 | .S X=$G(^DPT(DFN,.38))
|
---|
| 143 | .;Sequence 12 - Eligible for Medicaid
|
---|
| 144 | .I VAFSTR[12 S X1=$$YN^VAFHLFNC($P(X,"^",1)),@ARRAY@(12)=$S(X1]"":X1,1:HLQ)
|
---|
| 145 | .;Sequence 13 - Date Medicaid last asked
|
---|
| 146 | .I VAFSTR[13 S X1=$$HLDATE^HLFNC($P(X,"^",2)),@ARRAY@(13)=$S(X1]"":X1,1:HLQ)
|
---|
| 147 | ;Sequence 14 - Race
|
---|
| 148 | I VAFSTR[14 S X=$P(VAFNODE,"^",6) S X1=$P($G(^DIC(10,+X,0)),"^",2),@ARRAY@(14)=$S(X1]"":X1,1:HLQ)
|
---|
| 149 | ;Sequence 15 - Religious Preference
|
---|
| 150 | I VAFSTR[15 S X=$P(VAFNODE,"^",8) S X1=$P($G(^DIC(13,+X,0)),"^",4),@ARRAY@(15)=$S(X1]"":X1,1:HLQ)
|
---|
| 151 | ;Sequence 16 - Homeless Indicator
|
---|
| 152 | I VAFSTR[16 S X=$T(HOMELESS^SOWKHIRM) S @ARRAY@(16)=$S(X]"":$$HOMELESS^SOWKHIRM(DFN),1:HLQ)
|
---|
| 153 | ;Sequences 17 & 20
|
---|
| 154 | I ((VAFSTR[17)!(VAFSTR[20)) D
|
---|
| 155 | .;POW Status & Location
|
---|
| 156 | .N VAF52,POW,LOC
|
---|
| 157 | .S VAF52=$G(^DPT(DFN,.52))
|
---|
| 158 | .;POW Status Indicated?
|
---|
| 159 | .S POW=$P(VAF52,"^",5)
|
---|
| 160 | .S:(POW="") POW=HLQ
|
---|
| 161 | .;POW Confinement Location (translates pointer to coded value)
|
---|
| 162 | .S LOC=$P(VAF52,"^",6)
|
---|
| 163 | .S:(LOC="") LOC=HLQ
|
---|
| 164 | .I (LOC'=HLQ) S LOC=$S(LOC>0&(LOC<7):LOC+3,LOC>6&(LOC<9):$C(LOC+58),1:"")
|
---|
| 165 | .;Add to output array
|
---|
| 166 | .;Sequence 17 - POW Status
|
---|
| 167 | .S:(VAFSTR[17) @ARRAY@(17)=POW
|
---|
| 168 | .;Sequence 20 - POW Confinement Location
|
---|
| 169 | .S:(VAFSTR[20) @ARRAY@(20)=LOC
|
---|
| 170 | ;Sequence 18 - Insurance Type
|
---|
| 171 | I VAFSTR[18 S X=+$$INSTYP^IBCNS1(DFN),@ARRAY@(18)=$S(X]"":X,1:HLQ)
|
---|
| 172 | ;Sequence 19 - RX Copay Exemption Status
|
---|
| 173 | I VAFSTR[19 S X=+$$RXST^IBARXEU(DFN),@ARRAY@(19)=$S(X'<0:X,1:HLQ)
|
---|
| 174 | ;Sequence 21 - Primary Care Team
|
---|
| 175 | I (VAFSTR[21) D
|
---|
| 176 | .;Get Primary Care Team (as defined in PCMM)
|
---|
| 177 | .S X=$$PCTEAM^DGSDUTL(DFN)
|
---|
| 178 | .S X=$P(X,"^",2)
|
---|
| 179 | .S:(X="") X=HLQ
|
---|
| 180 | .;Put into output array
|
---|
| 181 | .S @ARRAY@(21)=X
|
---|
| 182 | ;
|
---|
| 183 | ; Sequences 22 thru 30 added by DG*5.3*264 (Smart Card)
|
---|
| 184 | ;
|
---|
| 185 | ; Sequences 22 & 23
|
---|
| 186 | I VAFSTR[22!(VAFSTR[23) D
|
---|
| 187 | .; GI Insurance
|
---|
| 188 | .S X=$G(^DPT(DFN,.362))
|
---|
| 189 | .I VAFSTR[22 S X1=$P(X,U,17),@ARRAY@(22)=$S(X1="U":"N",X1]"":X1,1:HLQ)
|
---|
| 190 | .I VAFSTR[23 S X1=$P(X,U,6),@ARRAY@(23)=$S(X1:$E(X1,1,6),1:HLQ)
|
---|
| 191 | ; Sequences 24 through 27
|
---|
| 192 | I VAFSTR[24!(VAFSTR[25)!(VAFSTR[26)!(VAFSTR[27) D
|
---|
| 193 | .; Most recent care dates & locations
|
---|
| 194 | .S X=$G(^DPT(DFN,1010.15))
|
---|
| 195 | .I VAFSTR[24 S X1=$$HLDATE^HLFNC($P(X,U)),@ARRAY@(24)=$S(X1]"":X1,1:HLQ)
|
---|
| 196 | .I VAFSTR[25 S X1=$P(X,U,2),X1=$P($G(^DIC(4,+X1,0)),U),@ARRAY@(25)=$S(X1]"":X1,1:HLQ)
|
---|
| 197 | .I VAFSTR[26 S X1=$$HLDATE^HLFNC($P(X,U,3)),@ARRAY@(26)=$S(X1]"":X1,1:HLQ)
|
---|
| 198 | .I VAFSTR[27 S X1=$P(X,U,4),X1=$P($G(^DIC(4,+X1,0)),U),@ARRAY@(27)=$S(X1]"":X1,1:HLQ)
|
---|
| 199 | ; Sequences 28 & 29
|
---|
| 200 | I VAFSTR[28!(VAFSTR[29) D
|
---|
| 201 | .; dates ruled incompetent (civil and VA)
|
---|
| 202 | .S X=$G(^DPT(DFN,.29))
|
---|
| 203 | .I VAFSTR[28 S X1=$$HLDATE^HLFNC($P(X,U,2)),@ARRAY@(28)=$S(X1]"":X1,1:HLQ)
|
---|
| 204 | .I VAFSTR[29 S X1=$$HLDATE^HLFNC($P(X,U)),@ARRAY@(29)=$S(X1]"":X1,1:HLQ)
|
---|
| 205 | ; Sequence 30 - Spinal cord injury
|
---|
| 206 | I VAFSTR[30 S X=$P($G(^DPT(DFN,57)),U,4),@ARRAY@(30)=$S(X]"":X,1:HLQ)
|
---|
| 207 | ; Sequence 31 - Source of Notification
|
---|
| 208 | I VAFSTR[9&(VAFSTR[31) S X=$P($G(^DPT(DFN,.35)),U,3),@ARRAY@(31)=$S(X]"":X,1:HLQ)
|
---|
| 209 | ; Sequence 32 - Date/Time Last Updated
|
---|
| 210 | I VAFSTR[9&(VAFSTR[32) S X=$P($G(^DPT(DFN,.35)),U,4),X1=$$HLDATE^HLFNC(X),@ARRAY@(32)=$S(X1]"":X1,1:HLQ)
|
---|
| 211 | ; Sequence 33 - Filipino Veteran Proof
|
---|
| 212 | I VAFSTR[33 S X=$P($G(^DPT(DFN,.321)),U,14),@ARRAY@(33)=$S(X]"":X,1:HLQ)
|
---|
| 213 | ; Sequence 34 - Pseudo SSN Reason - Veteran
|
---|
| 214 | I VAFSTR[34 S X=$P($G(^DPT(DFN,"SSN")),U),@ARRAY@(34)=$S(X]"":X,1:HLQ)
|
---|
| 215 | ; Sequence 40 - Emergency Response Indicator
|
---|
| 216 | I VAFSTR[40 S X=$P($G(^DPT(DFN,.18)),U),@ARRAY@(40)=$S(X]"":X,1:HLQ)
|
---|
| 217 | ;Done - cleanup & quit
|
---|
| 218 | D KVA^VADPT
|
---|
| 219 | Q
|
---|
| 220 | ;
|
---|
| 221 | COMMANUM(FROM,TO) ;Build comma seperated list of numbers
|
---|
| 222 | ;Input : FROM - Starting number (default = 1)
|
---|
| 223 | ; TO - Ending number (default = FROM)
|
---|
| 224 | ;Output : Comma seperated list of numbers between FROM and TO
|
---|
| 225 | ; (Ex: 1,2,3)
|
---|
| 226 | ;Notes : Call assumes FROM <= TO
|
---|
| 227 | ;
|
---|
| 228 | S FROM=$G(FROM) S:(FROM="") FROM=1
|
---|
| 229 | S TO=$G(TO) S:(TO="") TO=FROM
|
---|
| 230 | N OUTPUT,X
|
---|
| 231 | S OUTPUT=FROM
|
---|
| 232 | F X=(FROM+1):1:TO S OUTPUT=(OUTPUT_","_X)
|
---|
| 233 | Q OUTPUT
|
---|