- 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
