VAFHLZPD ;ALB/KCL/PHH,TDM - Create generic HL7 ZPD segment ; 8/15/08 11:42am
;;5.3;PIMS;**94,122,160,220,247,545,564,568,677,653,688,1015,1016**;JUN 30, 2012;Build 20
;
;
EN(DFN,VAFSTR) ; This generic extrinsic function was designed to return
; sequences 1 throught 21 of the HL7 ZPD segment. This segment
; contains VA-specific patient information that is not contained in
; the HL7 PID segment. This call does not accomodate a segment
; length greater than 245 and has been superceeded by EN1^VAFHLZPD.
; This line tag has been left for backwards compatability.
;
;Input - DFN as internal entry number of the PATIENT file
; - VAFSTR as the string of fields requested seperated by commas
; (Defaults to all fields)
;
; *****Also assumes all HL7 variables returned from*****
; INIT^HLTRANS are defined.
;
;Output - String of data forming the ZPD segment.
;
;
N VAFY,VAFZPD,REMARKS
S VAFY=$$EN1($G(DFN),$G(VAFSTR))
;Segment less than 245 characters
I ('$D(VAFZPD(1))) D
. ;Remove sequences 22 and higher
. S VAFY=$P(VAFY,HLFS,1,22)
;Segment greater than 245 characters
I ($D(VAFZPD(1))) D
. ;Strip out REMARKS (seq 2)
. S REMARKS=$P(VAFY,HLFS,3)
. S $P(VAFY,HLFS,3)=""
. ;Append up to sequence 21 (PRIMARY CARE TEAM)
. S VAFY=VAFY_$P(VAFZPD(1),HLFS,1,((21-$L(VAFY,HLFS))+2))
. ;Place REMARKS back into segment, truncating if needed
. S $P(VAFY,HLFS,3)=$E(REMARKS,1,(245-$L(VAFY)))
;Done
Q VAFY
;
EN1(DFN,VAFSTR) ; This generic extrinsic function was designed to return the
; HL7 ZPD segment. This segment contains VA-specific patient
; information that is not contained in the HL7 PID segment. This
; call superceeds EN^VAFHLZPD because it accomodates a segment
; length greater than 245.
;
;
;Input : DFN - Pointer to PATIENT file (#2)
; VAFSTR - List of data elements to retrieve seperated
; by commas (ex: 1,2,3)
; - Defaults to all data elements
; Existance of HL7 encoding variables is assumed
; (HLFS, HLENC, HLQ)
;Output : ZPD segment
; : If the ZPD segment becomes longer than 245 characters,
; remaining fields will be placed in VAFZPD(1)
;Notes : Sequence 1 (Set ID) will always have a value of '1'
; : A ZPD segment with sequence one set to '1' will be returned
; if DFN is not valid
; : Variable VAFZPD is initialized on entry
;
;Declare variables
N VAFHLZPD,VAFY,SEQ,SPILL,SPILLON,SPOT,LASTSEQ,MAXLEN
K VAFZPD
S MAXLEN=245
;Get data
D GETDATA($G(DFN),$G(VAFSTR),"VAFHLZPD")
;Build segment
S VAFY="VAFHLZPD"
S SPILL=0
S SPILLON=0
S @VAFY="ZPD"
S LASTSEQ=+$O(VAFHLZPD(""),-1)
F SEQ=1:1:LASTSEQ D
. ;Make sure maximum length won't be exceeded
. I ($L(@VAFY)+$L($G(VAFHLZPD(SEQ)))+1)>MAXLEN D
. . ;Max length exceeded - start putting data on next node
. . S SPILL=SPILL+1
. . S SPILLON=SEQ-1
. . S VAFY=$NA(VAFZPD(SPILL))
. ;Add to string
. S SPOT=(SEQ+1)-SPILLON
. S $P(@VAFY,HLFS,SPOT)=$G(VAFHLZPD(SEQ))
;Return segment
Q VAFHLZPD
;
GETDATA(DFN,VAFSTR,ARRAY) ;Get info needed to build segment
;Input : DFN - Pointer to PATIENT file (#2)
; VAFSTR - List of data elements to retrieve seperated
; by commas (ex: 1,2,3)
; - Defaults to all data elements
; ARRAY - Array to return data in (full global reference)
; Defaults to ^TMP($J,"VAFHLZPD")
; Existance of HL7 encoding variables is assumed
; (HLFS, HLENC, HLQ)
;Output : Nothing
; ARRAY(SeqNum) = Value
;Notes : ARRAY is initialized (KILLed) on entry
; : Sequence 1 (Set ID) will always have a value of '1'
;
;Check input
S ARRAY=$G(ARRAY)
S:(ARRAY="") ARRAY=$NA(^TMP($J,"VAFHLZPD"))
K @ARRAY
;Sequence 1 - Set ID
; value is always '1'
S @ARRAY@(1)=1
S DFN=+$G(DFN)
S VAFSTR=$G(VAFSTR)
S:(VAFSTR="") VAFSTR=$$COMMANUM(1,40)
S VAFSTR=","_VAFSTR_","
;Declare variables
N VAFNODE,VAPD,X1,X
;Get zero node
S VAFNODE=$G(^DPT(DFN,0))
;Get other patient data from VADPT
D OPD^VADPT
;Sequence 2 - Remarks (truncate to 60 characters)
I VAFSTR[",2," S X=$P(VAFNODE,"^",10),@ARRAY@(2)=$S(X="":HLQ,1:$E(X,1,60))
;Sequence 3 - Place of birth (city)
I VAFSTR[",3," S @ARRAY@(3)=$S(VAPD(1)]"":VAPD(1),1:HLQ)
;Sequence 4 - Place of birth (State abbrv.)
I VAFSTR[",4," S X1=$P($G(^DIC(5,$P(+VAPD(2),"^",1),0)),"^",2),@ARRAY@(4)=$S(X1]"":X1,1:HLQ)
;Sequence 5 - Current means test status
I VAFSTR[",5," S X=$P(VAFNODE,"^",14),X1=$P($G(^DG(408.32,+X,0)),"^",2),@ARRAY@(5)=$S(X1]"":X1,1:HLQ)
;Sequence 6 - Fathers name
I VAFSTR[",6," S @ARRAY@(6)=$S(VAPD(3)]"":VAPD(3),1:HLQ)
;Sequence 7 - Mothers name
I VAFSTR[",7," S @ARRAY@(7)=$S(VAPD(4)]"":VAPD(4),1:HLQ)
;Sequence 8 - Rated incompetent
I VAFSTR[",8," S X1=$$YN^VAFHLFNC($P($G(^DPT(DFN,.29)),"^",12)),@ARRAY@(8)=$S(X1]"":X1,1:HLQ)
;Sequence 9 - Date of Death
I VAFSTR[",9," S X=$P($G(^DPT(DFN,.35)),"^",1),X1=$$HLDATE^HLFNC(X),@ARRAY@(9)=$S(X1]"":X1,1:HLQ)
;Sequence 10 - Collateral sponser name
I VAFSTR[10 D
. S X=$P($G(^DPT(DFN,.36)),"^",11)
. S X1=$P($G(^DPT(+X,0)),"^",1)
. S @ARRAY@(10)=$S(X1]"":X1,1:HLQ)
;Sequence 11 - Active Health Insurance?
I VAFSTR[11 S X=$$INS^VAFHLFNC(DFN),X1=$$YN^VAFHLFNC(X),@ARRAY@(11)=$S(X1]"":X1,1:HLQ)
;Sequences 12 & 13
I VAFSTR[12!(VAFSTR[13) D
. S X=$G(^DPT(DFN,.38))
. ;Sequence 12 - Eligible for Medicaid
. I VAFSTR[12 S X1=$$YN^VAFHLFNC($P(X,"^",1)),@ARRAY@(12)=$S(X1]"":X1,1:HLQ)
. ;Sequence 13 - Date Medicaid last asked
. I VAFSTR[13 S X1=$$HLDATE^HLFNC($P(X,"^",2)),@ARRAY@(13)=$S(X1]"":X1,1:HLQ)
;Sequence 14 - Race
I VAFSTR[14 S X=$P(VAFNODE,"^",6) S X1=$P($G(^DIC(10,+X,0)),"^",2),@ARRAY@(14)=$S(X1]"":X1,1:HLQ)
;Sequence 15 - Religious Preference
I VAFSTR[15 S X=$P(VAFNODE,"^",8) S X1=$P($G(^DIC(13,+X,0)),"^",4),@ARRAY@(15)=$S(X1]"":X1,1:HLQ)
;Sequence 16 - Homeless Indicator
I VAFSTR[16 S X=$T(HOMELESS^SOWKHIRM) S @ARRAY@(16)=$S(X]"":$$HOMELESS^SOWKHIRM(DFN),1:HLQ)
;Sequences 17 & 20
I ((VAFSTR[17)!(VAFSTR[20)) D
. ;POW Status & Location
. N VAF52,POW,LOC
. S VAF52=$G(^DPT(DFN,.52))
. ;POW Status Indicated?
. S POW=$P(VAF52,"^",5)
. S:(POW="") POW=HLQ
. ;POW Confinement Location (translates pointer to coded value)
. S LOC=$P(VAF52,"^",6)
. S:(LOC="") LOC=HLQ
. I (LOC'=HLQ) S LOC=$S(LOC>0&(LOC<7):LOC+3,LOC>6&(LOC<9):$C(LOC+58),1:"")
. ;Add to output array
. ;Sequence 17 - POW Status
. S:(VAFSTR[17) @ARRAY@(17)=POW
. ;Sequence 20 - POW Confinement Location
. S:(VAFSTR[20) @ARRAY@(20)=LOC
;Sequence 18 - Insurance Type
;I VAFSTR[18 S X=+$$INSTYP^IBCNS1(DFN),@ARRAY@(18)=$S(X]"":X,1:HLQ) ;ihs/cmi/maw 7/17/2012 PATCH 1016 no IB routines in IHS
;Sequence 19 - RX Copay Exemption Status
I VAFSTR[19 S X=+$$RXST^IBARXEU(DFN),@ARRAY@(19)=$S(X'<0:X,1:HLQ)
;Sequence 21 - Primary Care Team
I (VAFSTR[21) D
. ;Get Primary Care Team (as defined in PCMM)
. S X=$$PCTEAM^DGSDUTL(DFN)
. S X=$P(X,"^",2)
. S:(X="") X=HLQ
. ;Put into output array
. S @ARRAY@(21)=X
;
; Sequences 22 thru 30 added by DG*5.3*264 (Smart Card)
;
; Sequences 22 & 23
I VAFSTR[22!(VAFSTR[23) D
. ; GI Insurance
. S X=$G(^DPT(DFN,.362))
. I VAFSTR[22 S X1=$P(X,U,17),@ARRAY@(22)=$S(X1="U":"N",X1]"":X1,1:HLQ)
. I VAFSTR[23 S X1=$P(X,U,6),@ARRAY@(23)=$S(X1:$E(X1,1,6),1:HLQ)
; Sequences 24 through 27
I VAFSTR[24!(VAFSTR[25)!(VAFSTR[26)!(VAFSTR[27) D
. ; Most recent care dates & locations
. S X=$G(^DPT(DFN,1010.15))
. I VAFSTR[24 S X1=$$HLDATE^HLFNC($P(X,U)),@ARRAY@(24)=$S(X1]"":X1,1:HLQ)
. I VAFSTR[25 S X1=$P(X,U,2),X1=$P($G(^DIC(4,+X1,0)),U),@ARRAY@(25)=$S(X1]"":X1,1:HLQ)
. I VAFSTR[26 S X1=$$HLDATE^HLFNC($P(X,U,3)),@ARRAY@(26)=$S(X1]"":X1,1:HLQ)
. I VAFSTR[27 S X1=$P(X,U,4),X1=$P($G(^DIC(4,+X1,0)),U),@ARRAY@(27)=$S(X1]"":X1,1:HLQ)
; Sequences 28 & 29
I VAFSTR[28!(VAFSTR[29) D
. ; dates ruled incompetent (civil and VA)
. S X=$G(^DPT(DFN,.29))
. I VAFSTR[28 S X1=$$HLDATE^HLFNC($P(X,U,2)),@ARRAY@(28)=$S(X1]"":X1,1:HLQ)
. I VAFSTR[29 S X1=$$HLDATE^HLFNC($P(X,U)),@ARRAY@(29)=$S(X1]"":X1,1:HLQ)
; Sequence 30 - Spinal cord injury
I VAFSTR[30 S X=$P($G(^DPT(DFN,57)),U,4),@ARRAY@(30)=$S(X]"":X,1:HLQ)
; Sequence 31 - Source of Notification
I VAFSTR[9&(VAFSTR[31) S X=$P($G(^DPT(DFN,.35)),U,3),@ARRAY@(31)=$S(X]"":X,1:HLQ)
; Sequence 32 - Date/Time Last Updated
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)
; Sequence 33 - Filipino Veteran Proof
I VAFSTR[33 S X=$P($G(^DPT(DFN,.321)),U,14),@ARRAY@(33)=$S(X]"":X,1:HLQ)
; Sequence 34 - Pseudo SSN Reason - Veteran
I VAFSTR[34 S X=$P($G(^DPT(DFN,"SSN")),U),@ARRAY@(34)=$S(X]"":X,1:HLQ)
; Sequence 35 - Agency/Allied Country
I VAFSTR[35 S X=$P($G(^DPT(DFN,.3)),U,9),X1=$P($G(^DIC(35,+X,0)),U,2),@ARRAY@(35)=$S(X1]"":X1,1:HLQ)
; Sequence 40 - Emergency Response Indicator
I VAFSTR[40 S X=$P($G(^DPT(DFN,.18)),U),@ARRAY@(40)=$S(X]"":X,1:HLQ)
;Done - cleanup & quit
D KVA^VADPT
Q
;
COMMANUM(FROM,TO) ;Build comma seperated list of numbers
;Input : FROM - Starting number (default = 1)
; TO - Ending number (default = FROM)
;Output : Comma seperated list of numbers between FROM and TO
; (Ex: 1,2,3)
;Notes : Call assumes FROM <= TO
;
S FROM=$G(FROM) S:(FROM="") FROM=1
S TO=$G(TO) S:(TO="") TO=FROM
N OUTPUT,X
S OUTPUT=FROM
F X=(FROM+1):1:TO S OUTPUT=(OUTPUT_","_X)
Q OUTPUT
VAFHLZPD ;ALB/KCL/PHH,TDM - Create generic HL7 ZPD segment ; 8/15/08 11:42am
+1 ;;5.3;PIMS;**94,122,160,220,247,545,564,568,677,653,688,1015,1016**;JUN 30, 2012;Build 20
+2 ;
+3 ;
EN(DFN,VAFSTR) ; This generic extrinsic function was designed to return
+1 ; sequences 1 throught 21 of the HL7 ZPD segment. This segment
+2 ; contains VA-specific patient information that is not contained in
+3 ; the HL7 PID segment. This call does not accomodate a segment
+4 ; length greater than 245 and has been superceeded by EN1^VAFHLZPD.
+5 ; This line tag has been left for backwards compatability.
+6 ;
+7 ;Input - DFN as internal entry number of the PATIENT file
+8 ; - VAFSTR as the string of fields requested seperated by commas
+9 ; (Defaults to all fields)
+10 ;
+11 ; *****Also assumes all HL7 variables returned from*****
+12 ; INIT^HLTRANS are defined.
+13 ;
+14 ;Output - String of data forming the ZPD segment.
+15 ;
+16 ;
+17 NEW VAFY,VAFZPD,REMARKS
+18 SET VAFY=$$EN1($GET(DFN),$GET(VAFSTR))
+19 ;Segment less than 245 characters
+20 IF ('$DATA(VAFZPD(1)))
Begin DoDot:1
+21 ;Remove sequences 22 and higher
+22 SET VAFY=$PIECE(VAFY,HLFS,1,22)
End DoDot:1
+23 ;Segment greater than 245 characters
+24 IF ($DATA(VAFZPD(1)))
Begin DoDot:1
+25 ;Strip out REMARKS (seq 2)
+26 SET REMARKS=$PIECE(VAFY,HLFS,3)
+27 SET $PIECE(VAFY,HLFS,3)=""
+28 ;Append up to sequence 21 (PRIMARY CARE TEAM)
+29 SET VAFY=VAFY_$PIECE(VAFZPD(1),HLFS,1,((21-$LENGTH(VAFY,HLFS))+2))
+30 ;Place REMARKS back into segment, truncating if needed
+31 SET $PIECE(VAFY,HLFS,3)=$EXTRACT(REMARKS,1,(245-$LENGTH(VAFY)))
End DoDot:1
+32 ;Done
+33 QUIT VAFY
+34 ;
EN1(DFN,VAFSTR) ; This generic extrinsic function was designed to return the
+1 ; HL7 ZPD segment. This segment contains VA-specific patient
+2 ; information that is not contained in the HL7 PID segment. This
+3 ; call superceeds EN^VAFHLZPD because it accomodates a segment
+4 ; length greater than 245.
+5 ;
+6 ;
+7 ;Input : DFN - Pointer to PATIENT file (#2)
+8 ; VAFSTR - List of data elements to retrieve seperated
+9 ; by commas (ex: 1,2,3)
+10 ; - Defaults to all data elements
+11 ; Existance of HL7 encoding variables is assumed
+12 ; (HLFS, HLENC, HLQ)
+13 ;Output : ZPD segment
+14 ; : If the ZPD segment becomes longer than 245 characters,
+15 ; remaining fields will be placed in VAFZPD(1)
+16 ;Notes : Sequence 1 (Set ID) will always have a value of '1'
+17 ; : A ZPD segment with sequence one set to '1' will be returned
+18 ; if DFN is not valid
+19 ; : Variable VAFZPD is initialized on entry
+20 ;
+21 ;Declare variables
+22 NEW VAFHLZPD,VAFY,SEQ,SPILL,SPILLON,SPOT,LASTSEQ,MAXLEN
+23 KILL VAFZPD
+24 SET MAXLEN=245
+25 ;Get data
+26 DO GETDATA($GET(DFN),$GET(VAFSTR),"VAFHLZPD")
+27 ;Build segment
+28 SET VAFY="VAFHLZPD"
+29 SET SPILL=0
+30 SET SPILLON=0
+31 SET @VAFY="ZPD"
+32 SET LASTSEQ=+$ORDER(VAFHLZPD(""),-1)
+33 FOR SEQ=1:1:LASTSEQ
Begin DoDot:1
+34 ;Make sure maximum length won't be exceeded
+35 IF ($LENGTH(@VAFY)+$LENGTH($GET(VAFHLZPD(SEQ)))+1)>MAXLEN
Begin DoDot:2
+36 ;Max length exceeded - start putting data on next node
+37 SET SPILL=SPILL+1
+38 SET SPILLON=SEQ-1
+39 SET VAFY=$NAME(VAFZPD(SPILL))
End DoDot:2
+40 ;Add to string
+41 SET SPOT=(SEQ+1)-SPILLON
+42 SET $PIECE(@VAFY,HLFS,SPOT)=$GET(VAFHLZPD(SEQ))
End DoDot:1
+43 ;Return segment
+44 QUIT VAFHLZPD
+45 ;
GETDATA(DFN,VAFSTR,ARRAY) ;Get info needed to build segment
+1 ;Input : DFN - Pointer to PATIENT file (#2)
+2 ; VAFSTR - List of data elements to retrieve seperated
+3 ; by commas (ex: 1,2,3)
+4 ; - Defaults to all data elements
+5 ; ARRAY - Array to return data in (full global reference)
+6 ; Defaults to ^TMP($J,"VAFHLZPD")
+7 ; Existance of HL7 encoding variables is assumed
+8 ; (HLFS, HLENC, HLQ)
+9 ;Output : Nothing
+10 ; ARRAY(SeqNum) = Value
+11 ;Notes : ARRAY is initialized (KILLed) on entry
+12 ; : Sequence 1 (Set ID) will always have a value of '1'
+13 ;
+14 ;Check input
+15 SET ARRAY=$GET(ARRAY)
+16 IF (ARRAY="")
SET ARRAY=$NAME(^TMP($JOB,"VAFHLZPD"))
+17 KILL @ARRAY
+18 ;Sequence 1 - Set ID
+19 ; value is always '1'
+20 SET @ARRAY@(1)=1
+21 SET DFN=+$GET(DFN)
+22 SET VAFSTR=$GET(VAFSTR)
+23 IF (VAFSTR="")
SET VAFSTR=$$COMMANUM(1,40)
+24 SET VAFSTR=","_VAFSTR_","
+25 ;Declare variables
+26 NEW VAFNODE,VAPD,X1,X
+27 ;Get zero node
+28 SET VAFNODE=$GET(^DPT(DFN,0))
+29 ;Get other patient data from VADPT
+30 DO OPD^VADPT
+31 ;Sequence 2 - Remarks (truncate to 60 characters)
+32 IF VAFSTR[",2,"
SET X=$PIECE(VAFNODE,"^",10)
SET @ARRAY@(2)=$SELECT(X="":HLQ,1:$EXTRACT(X,1,60))
+33 ;Sequence 3 - Place of birth (city)
+34 IF VAFSTR[",3,"
SET @ARRAY@(3)=$SELECT(VAPD(1)]"":VAPD(1),1:HLQ)
+35 ;Sequence 4 - Place of birth (State abbrv.)
+36 IF VAFSTR[",4,"
SET X1=$PIECE($GET(^DIC(5,$PIECE(+VAPD(2),"^",1),0)),"^",2)
SET @ARRAY@(4)=$SELECT(X1]"":X1,1:HLQ)
+37 ;Sequence 5 - Current means test status
+38 IF VAFSTR[",5,"
SET X=$PIECE(VAFNODE,"^",14)
SET X1=$PIECE($GET(^DG(408.32,+X,0)),"^",2)
SET @ARRAY@(5)=$SELECT(X1]"":X1,1:HLQ)
+39 ;Sequence 6 - Fathers name
+40 IF VAFSTR[",6,"
SET @ARRAY@(6)=$SELECT(VAPD(3)]"":VAPD(3),1:HLQ)
+41 ;Sequence 7 - Mothers name
+42 IF VAFSTR[",7,"
SET @ARRAY@(7)=$SELECT(VAPD(4)]"":VAPD(4),1:HLQ)
+43 ;Sequence 8 - Rated incompetent
+44 IF VAFSTR[",8,"
SET X1=$$YN^VAFHLFNC($PIECE($GET(^DPT(DFN,.29)),"^",12))
SET @ARRAY@(8)=$SELECT(X1]"":X1,1:HLQ)
+45 ;Sequence 9 - Date of Death
+46 IF VAFSTR[",9,"
SET X=$PIECE($GET(^DPT(DFN,.35)),"^",1)
SET X1=$$HLDATE^HLFNC(X)
SET @ARRAY@(9)=$SELECT(X1]"":X1,1:HLQ)
+47 ;Sequence 10 - Collateral sponser name
+48 IF VAFSTR[10
Begin DoDot:1
+49 SET X=$PIECE($GET(^DPT(DFN,.36)),"^",11)
+50 SET X1=$PIECE($GET(^DPT(+X,0)),"^",1)
+51 SET @ARRAY@(10)=$SELECT(X1]"":X1,1:HLQ)
End DoDot:1
+52 ;Sequence 11 - Active Health Insurance?
+53 IF VAFSTR[11
SET X=$$INS^VAFHLFNC(DFN)
SET X1=$$YN^VAFHLFNC(X)
SET @ARRAY@(11)=$SELECT(X1]"":X1,1:HLQ)
+54 ;Sequences 12 & 13
+55 IF VAFSTR[12!(VAFSTR[13)
Begin DoDot:1
+56 SET X=$GET(^DPT(DFN,.38))
+57 ;Sequence 12 - Eligible for Medicaid
+58 IF VAFSTR[12
SET X1=$$YN^VAFHLFNC($PIECE(X,"^",1))
SET @ARRAY@(12)=$SELECT(X1]"":X1,1:HLQ)
+59 ;Sequence 13 - Date Medicaid last asked
+60 IF VAFSTR[13
SET X1=$$HLDATE^HLFNC($PIECE(X,"^",2))
SET @ARRAY@(13)=$SELECT(X1]"":X1,1:HLQ)
End DoDot:1
+61 ;Sequence 14 - Race
+62 IF VAFSTR[14
SET X=$PIECE(VAFNODE,"^",6)
SET X1=$PIECE($GET(^DIC(10,+X,0)),"^",2)
SET @ARRAY@(14)=$SELECT(X1]"":X1,1:HLQ)
+63 ;Sequence 15 - Religious Preference
+64 IF VAFSTR[15
SET X=$PIECE(VAFNODE,"^",8)
SET X1=$PIECE($GET(^DIC(13,+X,0)),"^",4)
SET @ARRAY@(15)=$SELECT(X1]"":X1,1:HLQ)
+65 ;Sequence 16 - Homeless Indicator
+66 IF VAFSTR[16
SET X=$TEXT(HOMELESS^SOWKHIRM)
SET @ARRAY@(16)=$SELECT(X]"":$$HOMELESS^SOWKHIRM(DFN),1:HLQ)
+67 ;Sequences 17 & 20
+68 IF ((VAFSTR[17)!(VAFSTR[20))
Begin DoDot:1
+69 ;POW Status & Location
+70 NEW VAF52,POW,LOC
+71 SET VAF52=$GET(^DPT(DFN,.52))
+72 ;POW Status Indicated?
+73 SET POW=$PIECE(VAF52,"^",5)
+74 IF (POW="")
SET POW=HLQ
+75 ;POW Confinement Location (translates pointer to coded value)
+76 SET LOC=$PIECE(VAF52,"^",6)
+77 IF (LOC="")
SET LOC=HLQ
+78 IF (LOC'=HLQ)
SET LOC=$SELECT(LOC>0&(LOC<7):LOC+3,LOC>6&(LOC<9):$CHAR(LOC+58),1:"")
+79 ;Add to output array
+80 ;Sequence 17 - POW Status
+81 IF (VAFSTR[17)
SET @ARRAY@(17)=POW
+82 ;Sequence 20 - POW Confinement Location
+83 IF (VAFSTR[20)
SET @ARRAY@(20)=LOC
End DoDot:1
+84 ;Sequence 18 - Insurance Type
+85 ;I VAFSTR[18 S X=+$$INSTYP^IBCNS1(DFN),@ARRAY@(18)=$S(X]"":X,1:HLQ) ;ihs/cmi/maw 7/17/2012 PATCH 1016 no IB routines in IHS
+86 ;Sequence 19 - RX Copay Exemption Status
+87 IF VAFSTR[19
SET X=+$$RXST^IBARXEU(DFN)
SET @ARRAY@(19)=$SELECT(X'<0:X,1:HLQ)
+88 ;Sequence 21 - Primary Care Team
+89 IF (VAFSTR[21)
Begin DoDot:1
+90 ;Get Primary Care Team (as defined in PCMM)
+91 SET X=$$PCTEAM^DGSDUTL(DFN)
+92 SET X=$PIECE(X,"^",2)
+93 IF (X="")
SET X=HLQ
+94 ;Put into output array
+95 SET @ARRAY@(21)=X
End DoDot:1
+96 ;
+97 ; Sequences 22 thru 30 added by DG*5.3*264 (Smart Card)
+98 ;
+99 ; Sequences 22 & 23
+100 IF VAFSTR[22!(VAFSTR[23)
Begin DoDot:1
+101 ; GI Insurance
+102 SET X=$GET(^DPT(DFN,.362))
+103 IF VAFSTR[22
SET X1=$PIECE(X,U,17)
SET @ARRAY@(22)=$SELECT(X1="U":"N",X1]"":X1,1:HLQ)
+104 IF VAFSTR[23
SET X1=$PIECE(X,U,6)
SET @ARRAY@(23)=$SELECT(X1:$EXTRACT(X1,1,6),1:HLQ)
End DoDot:1
+105 ; Sequences 24 through 27
+106 IF VAFSTR[24!(VAFSTR[25)!(VAFSTR[26)!(VAFSTR[27)
Begin DoDot:1
+107 ; Most recent care dates & locations
+108 SET X=$GET(^DPT(DFN,1010.15))
+109 IF VAFSTR[24
SET X1=$$HLDATE^HLFNC($PIECE(X,U))
SET @ARRAY@(24)=$SELECT(X1]"":X1,1:HLQ)
+110 IF VAFSTR[25
SET X1=$PIECE(X,U,2)
SET X1=$PIECE($GET(^DIC(4,+X1,0)),U)
SET @ARRAY@(25)=$SELECT(X1]"":X1,1:HLQ)
+111 IF VAFSTR[26
SET X1=$$HLDATE^HLFNC($PIECE(X,U,3))
SET @ARRAY@(26)=$SELECT(X1]"":X1,1:HLQ)
+112 IF VAFSTR[27
SET X1=$PIECE(X,U,4)
SET X1=$PIECE($GET(^DIC(4,+X1,0)),U)
SET @ARRAY@(27)=$SELECT(X1]"":X1,1:HLQ)
End DoDot:1
+113 ; Sequences 28 & 29
+114 IF VAFSTR[28!(VAFSTR[29)
Begin DoDot:1
+115 ; dates ruled incompetent (civil and VA)
+116 SET X=$GET(^DPT(DFN,.29))
+117 IF VAFSTR[28
SET X1=$$HLDATE^HLFNC($PIECE(X,U,2))
SET @ARRAY@(28)=$SELECT(X1]"":X1,1:HLQ)
+118 IF VAFSTR[29
SET X1=$$HLDATE^HLFNC($PIECE(X,U))
SET @ARRAY@(29)=$SELECT(X1]"":X1,1:HLQ)
End DoDot:1
+119 ; Sequence 30 - Spinal cord injury
+120 IF VAFSTR[30
SET X=$PIECE($GET(^DPT(DFN,57)),U,4)
SET @ARRAY@(30)=$SELECT(X]"":X,1:HLQ)
+121 ; Sequence 31 - Source of Notification
+122 IF VAFSTR[9&(VAFSTR[31)
SET X=$PIECE($GET(^DPT(DFN,.35)),U,3)
SET @ARRAY@(31)=$SELECT(X]"":X,1:HLQ)
+123 ; Sequence 32 - Date/Time Last Updated
+124 IF VAFSTR[9&(VAFSTR[32)
SET X=$PIECE($GET(^DPT(DFN,.35)),U,4)
SET X1=$$HLDATE^HLFNC(X)
SET @ARRAY@(32)=$SELECT(X1]"":X1,1:HLQ)
+125 ; Sequence 33 - Filipino Veteran Proof
+126 IF VAFSTR[33
SET X=$PIECE($GET(^DPT(DFN,.321)),U,14)
SET @ARRAY@(33)=$SELECT(X]"":X,1:HLQ)
+127 ; Sequence 34 - Pseudo SSN Reason - Veteran
+128 IF VAFSTR[34
SET X=$PIECE($GET(^DPT(DFN,"SSN")),U)
SET @ARRAY@(34)=$SELECT(X]"":X,1:HLQ)
+129 ; Sequence 35 - Agency/Allied Country
+130 IF VAFSTR[35
SET X=$PIECE($GET(^DPT(DFN,.3)),U,9)
SET X1=$PIECE($GET(^DIC(35,+X,0)),U,2)
SET @ARRAY@(35)=$SELECT(X1]"":X1,1:HLQ)
+131 ; Sequence 40 - Emergency Response Indicator
+132 IF VAFSTR[40
SET X=$PIECE($GET(^DPT(DFN,.18)),U)
SET @ARRAY@(40)=$SELECT(X]"":X,1:HLQ)
+133 ;Done - cleanup & quit
+134 DO KVA^VADPT
+135 QUIT
+136 ;
COMMANUM(FROM,TO) ;Build comma seperated list of numbers
+1 ;Input : FROM - Starting number (default = 1)
+2 ; TO - Ending number (default = FROM)
+3 ;Output : Comma seperated list of numbers between FROM and TO
+4 ; (Ex: 1,2,3)
+5 ;Notes : Call assumes FROM <= TO
+6 ;
+7 SET FROM=$GET(FROM)
IF (FROM="")
SET FROM=1
+8 SET TO=$GET(TO)
IF (TO="")
SET TO=FROM
+9 NEW OUTPUT,X
+10 SET OUTPUT=FROM
+11 FOR X=(FROM+1):1:TO
SET OUTPUT=(OUTPUT_","_X)
+12 QUIT OUTPUT
