VAFHLZPD ;ALB/KCL/PHH,TDM,KUM - Create generic HL7 ZPD segment ; 8/15/08 11:42am
;;5.3;Registration;**94,122,160,220,247,545,564,568,677,653,688,1002,1064,1085,1093**;Aug 13, 1993;Build 12
;
;
;ICRs
; Reference to NAME,^DI(.85 in ICR #6062
;
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)
;DG*5.3*1085 - Include sequence numbers for Preferred Language and Preferred Language Date/Time
;S:(VAFSTR="") VAFSTR=$$COMMANUM(1,40)
S:(VAFSTR="") VAFSTR=$$COMMANUM(1,47)
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) ;Social Work being decommissioned, API call will no longer be active
I VAFSTR[16 S @ARRAY@(16)=$S($$BADADR^DGUTL3(DFN)=2:1,1:0) ;DG 1002 uses different API call for Homeless Indicator
;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)
;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)
; KUM - DG*5.3*1064 - MegaBus Changes
; Sequence 41 - VOA Attachments Indicator - Not used - Added to make sure Seq 42 to 45 communication to ES
I VAFSTR[41 S X="",@ARRAY@(41)=$S(X]"":X,1:HLQ)
;
; KUM - DG*5.3*1093 - Making null value for 42, 43, 44, 45
I VAFSTR[42 S @ARRAY@(42)=HLQ
I VAFSTR[43 S @ARRAY@(43)=HLQ
I VAFSTR[44 S @ARRAY@(44)=HLQ
I VAFSTR[45 S @ARRAY@(45)=HLQ
;N VAFINDARR
;D GETS^DIQ(2,DFN,".571:.574","I","VAFINDARR")
; Sequence 42 - Indian Self Identification
;I VAFSTR[42 S X=VAFINDARR(2,DFN_",",.571,"I"),X=$S(X="Y":1,X="N":0,1:""),@ARRAY@(42)=$S(X]"":X,1:HLQ)
; Sequence 43 - Indian Attestation Date
;I VAFSTR[43 S X=VAFINDARR(2,DFN_",",.573,"I"),X1=$$HLDATE^HLFNC(X),@ARRAY@(43)=$S(X1]"":X1,1:HLQ)
; Sequence 44 - Indian Start Date
;I VAFSTR[44 S X=VAFINDARR(2,DFN_",",.572,"I"),X1=$$HLDATE^HLFNC(X),@ARRAY@(44)=$S(X1]"":X1,1:HLQ)
; Sequence 45 - Indian End Date
;I VAFSTR[45 S X=VAFINDARR(2,DFN_",",.574,"I"),X1=$$HLDATE^HLFNC(X),@ARRAY@(45)=$S(X1]"":X1,1:HLQ)
; DG*5.3*1085
; Retrieve Preferred Language and Preferred Language Date/Time
N DGDATE,DGDA,DGLANGNM,DGLANGDT,DG85IEN
S DGLANGDT="",DGLANGNM="",DG85IEN=""
S DGDATE="",DGDATE=$O(^DPT(DFN,.207,"B",DGDATE),-1) Q:DGDATE=""
I DGDATE'="" S DGDA=$O(^DPT(DFN,.207,"B",DGDATE,0))
I DGDA'="" D
.S DGLANGNM=$$GET1^DIQ(2.07,DGDA_","_DFN_",",.02)
.S DGLANGDT=$$GET1^DIQ(2.07,DGDA_","_DFN_",",.01,"I")
.I DGLANGNM="DECLINED TO ANSWER" S DGLANGNM="888" Q
.I DGLANGNM="NO PREFERENCE" S DGLANGNM="999" Q
.S DG85IEN=$$FIND1^DIC(.85,,"B",DGLANGNM)
.I DG85IEN'="" S DGLANGNM=$$GET1^DIQ(.85,DG85IEN_",",.03)
; Sequence 46 - Preferred Language
I VAFSTR[46 S X=DGLANGNM,@ARRAY@(46)=$S(X]"":X,1:HLQ)
; Sequence 47 - Preferred Language Update Date/Time
I VAFSTR[47 S X=$$HLDATE^HLFNC(DGLANGDT),@ARRAY@(47)=$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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFHLZPD 11826 printed Apr 09, 2024@22:05:43 Page 2
VAFHLZPD ;ALB/KCL/PHH,TDM,KUM - Create generic HL7 ZPD segment ; 8/15/08 11:42am
+1 ;;5.3;Registration;**94,122,160,220,247,545,564,568,677,653,688,1002,1064,1085,1093**;Aug 13, 1993;Build 12
+2 ;
+3 ;
+4 ;ICRs
+5 ; Reference to NAME,^DI(.85 in ICR #6062
+6 ;
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 ;DG*5.3*1085 - Include sequence numbers for Preferred Language and Preferred Language Date/Time
+24 ;S:(VAFSTR="") VAFSTR=$$COMMANUM(1,40)
+25 if (VAFSTR="")
SET VAFSTR=$$COMMANUM(1,47)
+26 SET VAFSTR=","_VAFSTR_","
+27 ;Declare variables
+28 NEW VAFNODE,VAPD,X1,X
+29 ;Get zero node
+30 SET VAFNODE=$GET(^DPT(DFN,0))
+31 ;Get other patient data from VADPT
+32 DO OPD^VADPT
+33 ;Sequence 2 - Remarks (truncate to 60 characters)
+34 IF VAFSTR[",2,"
SET X=$PIECE(VAFNODE,"^",10)
SET @ARRAY@(2)=$SELECT(X="":HLQ,1:$EXTRACT(X,1,60))
+35 ;Sequence 3 - Place of birth (city)
+36 IF VAFSTR[",3,"
SET @ARRAY@(3)=$SELECT(VAPD(1)]"":VAPD(1),1:HLQ)
+37 ;Sequence 4 - Place of birth (State abbrv.)
+38 IF VAFSTR[",4,"
SET X1=$PIECE($GET(^DIC(5,$PIECE(+VAPD(2),"^",1),0)),"^",2)
SET @ARRAY@(4)=$SELECT(X1]"":X1,1:HLQ)
+39 ;Sequence 5 - Current means test status
+40 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)
+41 ;Sequence 6 - Fathers name
+42 IF VAFSTR[",6,"
SET @ARRAY@(6)=$SELECT(VAPD(3)]"":VAPD(3),1:HLQ)
+43 ;Sequence 7 - Mothers name
+44 IF VAFSTR[",7,"
SET @ARRAY@(7)=$SELECT(VAPD(4)]"":VAPD(4),1:HLQ)
+45 ;Sequence 8 - Rated incompetent
+46 IF VAFSTR[",8,"
SET X1=$$YN^VAFHLFNC($PIECE($GET(^DPT(DFN,.29)),"^",12))
SET @ARRAY@(8)=$SELECT(X1]"":X1,1:HLQ)
+47 ;Sequence 9 - Date of Death
+48 IF VAFSTR[",9,"
SET X=$PIECE($GET(^DPT(DFN,.35)),"^",1)
SET X1=$$HLDATE^HLFNC(X)
SET @ARRAY@(9)=$SELECT(X1]"":X1,1:HLQ)
+49 ;Sequence 10 - Collateral sponser name
+50 IF VAFSTR[10
Begin DoDot:1
+51 SET X=$PIECE($GET(^DPT(DFN,.36)),"^",11)
+52 SET X1=$PIECE($GET(^DPT(+X,0)),"^",1)
+53 SET @ARRAY@(10)=$SELECT(X1]"":X1,1:HLQ)
End DoDot:1
+54 ;Sequence 11 - Active Health Insurance?
+55 IF VAFSTR[11
SET X=$$INS^VAFHLFNC(DFN)
SET X1=$$YN^VAFHLFNC(X)
SET @ARRAY@(11)=$SELECT(X1]"":X1,1:HLQ)
+56 ;Sequences 12 & 13
+57 IF VAFSTR[12!(VAFSTR[13)
Begin DoDot:1
+58 SET X=$GET(^DPT(DFN,.38))
+59 ;Sequence 12 - Eligible for Medicaid
+60 IF VAFSTR[12
SET X1=$$YN^VAFHLFNC($PIECE(X,"^",1))
SET @ARRAY@(12)=$SELECT(X1]"":X1,1:HLQ)
+61 ;Sequence 13 - Date Medicaid last asked
+62 IF VAFSTR[13
SET X1=$$HLDATE^HLFNC($PIECE(X,"^",2))
SET @ARRAY@(13)=$SELECT(X1]"":X1,1:HLQ)
End DoDot:1
+63 ;Sequence 14 - Race
+64 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)
+65 ;Sequence 15 - Religious Preference
+66 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)
+67 ;Sequence 16 - Homeless Indicator
+68 ;I VAFSTR[16 S X=$T(HOMELESS^SOWKHIRM) S @ARRAY@(16)=$S(X]"":$$HOMELESS^SOWKHIRM(DFN),1:HLQ) ;Social Work being decommissioned, API call will no longer be active
+69 ;DG 1002 uses different API call for Homeless Indicator
IF VAFSTR[16
SET @ARRAY@(16)=$SELECT($$BADADR^DGUTL3(DFN)=2:1,1:0)
+70 ;Sequences 17 & 20
+71 IF ((VAFSTR[17)!(VAFSTR[20))
Begin DoDot:1
+72 ;POW Status & Location
+73 NEW VAF52,POW,LOC
+74 SET VAF52=$GET(^DPT(DFN,.52))
+75 ;POW Status Indicated?
+76 SET POW=$PIECE(VAF52,"^",5)
+77 if (POW="")
SET POW=HLQ
+78 ;POW Confinement Location (translates pointer to coded value)
+79 SET LOC=$PIECE(VAF52,"^",6)
+80 if (LOC="")
SET LOC=HLQ
+81 IF (LOC'=HLQ)
SET LOC=$SELECT(LOC>0&(LOC<7):LOC+3,LOC>6&(LOC<9):$CHAR(LOC+58),1:"")
+82 ;Add to output array
+83 ;Sequence 17 - POW Status
+84 if (VAFSTR[17)
SET @ARRAY@(17)=POW
+85 ;Sequence 20 - POW Confinement Location
+86 if (VAFSTR[20)
SET @ARRAY@(20)=LOC
End DoDot:1
+87 ;Sequence 18 - Insurance Type
+88 IF VAFSTR[18
SET X=+$$INSTYP^IBCNS1(DFN)
SET @ARRAY@(18)=$SELECT(X]"":X,1:HLQ)
+89 ;Sequence 19 - RX Copay Exemption Status
+90 IF VAFSTR[19
SET X=+$$RXST^IBARXEU(DFN)
SET @ARRAY@(19)=$SELECT(X'<0:X,1:HLQ)
+91 ;Sequence 21 - Primary Care Team
+92 IF (VAFSTR[21)
Begin DoDot:1
+93 ;Get Primary Care Team (as defined in PCMM)
+94 SET X=$$PCTEAM^DGSDUTL(DFN)
+95 SET X=$PIECE(X,"^",2)
+96 if (X="")
SET X=HLQ
+97 ;Put into output array
+98 SET @ARRAY@(21)=X
End DoDot:1
+99 ;
+100 ; Sequences 22 thru 30 added by DG*5.3*264 (Smart Card)
+101 ;
+102 ; Sequences 22 & 23
+103 IF VAFSTR[22!(VAFSTR[23)
Begin DoDot:1
+104 ; GI Insurance
+105 SET X=$GET(^DPT(DFN,.362))
+106 IF VAFSTR[22
SET X1=$PIECE(X,U,17)
SET @ARRAY@(22)=$SELECT(X1="U":"N",X1]"":X1,1:HLQ)
+107 IF VAFSTR[23
SET X1=$PIECE(X,U,6)
SET @ARRAY@(23)=$SELECT(X1:$EXTRACT(X1,1,6),1:HLQ)
End DoDot:1
+108 ; Sequences 24 through 27
+109 IF VAFSTR[24!(VAFSTR[25)!(VAFSTR[26)!(VAFSTR[27)
Begin DoDot:1
+110 ; Most recent care dates & locations
+111 SET X=$GET(^DPT(DFN,1010.15))
+112 IF VAFSTR[24
SET X1=$$HLDATE^HLFNC($PIECE(X,U))
SET @ARRAY@(24)=$SELECT(X1]"":X1,1:HLQ)
+113 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)
+114 IF VAFSTR[26
SET X1=$$HLDATE^HLFNC($PIECE(X,U,3))
SET @ARRAY@(26)=$SELECT(X1]"":X1,1:HLQ)
+115 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
+116 ; Sequences 28 & 29
+117 IF VAFSTR[28!(VAFSTR[29)
Begin DoDot:1
+118 ; dates ruled incompetent (civil and VA)
+119 SET X=$GET(^DPT(DFN,.29))
+120 IF VAFSTR[28
SET X1=$$HLDATE^HLFNC($PIECE(X,U,2))
SET @ARRAY@(28)=$SELECT(X1]"":X1,1:HLQ)
+121 IF VAFSTR[29
SET X1=$$HLDATE^HLFNC($PIECE(X,U))
SET @ARRAY@(29)=$SELECT(X1]"":X1,1:HLQ)
End DoDot:1
+122 ; Sequence 30 - Spinal cord injury
+123 IF VAFSTR[30
SET X=$PIECE($GET(^DPT(DFN,57)),U,4)
SET @ARRAY@(30)=$SELECT(X]"":X,1:HLQ)
+124 ; Sequence 31 - Source of Notification
+125 IF VAFSTR[9&(VAFSTR[31)
SET X=$PIECE($GET(^DPT(DFN,.35)),U,3)
SET @ARRAY@(31)=$SELECT(X]"":X,1:HLQ)
+126 ; Sequence 32 - Date/Time Last Updated
+127 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)
+128 ; Sequence 33 - Filipino Veteran Proof
+129 IF VAFSTR[33
SET X=$PIECE($GET(^DPT(DFN,.321)),U,14)
SET @ARRAY@(33)=$SELECT(X]"":X,1:HLQ)
+130 ; Sequence 34 - Pseudo SSN Reason - Veteran
+131 IF VAFSTR[34
SET X=$PIECE($GET(^DPT(DFN,"SSN")),U)
SET @ARRAY@(34)=$SELECT(X]"":X,1:HLQ)
+132 ; Sequence 35 - Agency/Allied Country
+133 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)
+134 ; Sequence 40 - Emergency Response Indicator
+135 IF VAFSTR[40
SET X=$PIECE($GET(^DPT(DFN,.18)),U)
SET @ARRAY@(40)=$SELECT(X]"":X,1:HLQ)
+136 ; KUM - DG*5.3*1064 - MegaBus Changes
+137 ; Sequence 41 - VOA Attachments Indicator - Not used - Added to make sure Seq 42 to 45 communication to ES
+138 IF VAFSTR[41
SET X=""
SET @ARRAY@(41)=$SELECT(X]"":X,1:HLQ)
+139 ;
+140 ; KUM - DG*5.3*1093 - Making null value for 42, 43, 44, 45
+141 IF VAFSTR[42
SET @ARRAY@(42)=HLQ
+142 IF VAFSTR[43
SET @ARRAY@(43)=HLQ
+143 IF VAFSTR[44
SET @ARRAY@(44)=HLQ
+144 IF VAFSTR[45
SET @ARRAY@(45)=HLQ
+145 ;N VAFINDARR
+146 ;D GETS^DIQ(2,DFN,".571:.574","I","VAFINDARR")
+147 ; Sequence 42 - Indian Self Identification
+148 ;I VAFSTR[42 S X=VAFINDARR(2,DFN_",",.571,"I"),X=$S(X="Y":1,X="N":0,1:""),@ARRAY@(42)=$S(X]"":X,1:HLQ)
+149 ; Sequence 43 - Indian Attestation Date
+150 ;I VAFSTR[43 S X=VAFINDARR(2,DFN_",",.573,"I"),X1=$$HLDATE^HLFNC(X),@ARRAY@(43)=$S(X1]"":X1,1:HLQ)
+151 ; Sequence 44 - Indian Start Date
+152 ;I VAFSTR[44 S X=VAFINDARR(2,DFN_",",.572,"I"),X1=$$HLDATE^HLFNC(X),@ARRAY@(44)=$S(X1]"":X1,1:HLQ)
+153 ; Sequence 45 - Indian End Date
+154 ;I VAFSTR[45 S X=VAFINDARR(2,DFN_",",.574,"I"),X1=$$HLDATE^HLFNC(X),@ARRAY@(45)=$S(X1]"":X1,1:HLQ)
+155 ; DG*5.3*1085
+156 ; Retrieve Preferred Language and Preferred Language Date/Time
+157 NEW DGDATE,DGDA,DGLANGNM,DGLANGDT,DG85IEN
+158 SET DGLANGDT=""
SET DGLANGNM=""
SET DG85IEN=""
+159 SET DGDATE=""
SET DGDATE=$ORDER(^DPT(DFN,.207,"B",DGDATE),-1)
if DGDATE=""
QUIT
+160 IF DGDATE'=""
SET DGDA=$ORDER(^DPT(DFN,.207,"B",DGDATE,0))
+161 IF DGDA'=""
Begin DoDot:1
+162 SET DGLANGNM=$$GET1^DIQ(2.07,DGDA_","_DFN_",",.02)
+163 SET DGLANGDT=$$GET1^DIQ(2.07,DGDA_","_DFN_",",.01,"I")
+164 IF DGLANGNM="DECLINED TO ANSWER"
SET DGLANGNM="888"
QUIT
+165 IF DGLANGNM="NO PREFERENCE"
SET DGLANGNM="999"
QUIT
+166 SET DG85IEN=$$FIND1^DIC(.85,,"B",DGLANGNM)
+167 IF DG85IEN'=""
SET DGLANGNM=$$GET1^DIQ(.85,DG85IEN_",",.03)
End DoDot:1
+168 ; Sequence 46 - Preferred Language
+169 IF VAFSTR[46
SET X=DGLANGNM
SET @ARRAY@(46)=$SELECT(X]"":X,1:HLQ)
+170 ; Sequence 47 - Preferred Language Update Date/Time
+171 IF VAFSTR[47
SET X=$$HLDATE^HLFNC(DGLANGDT)
SET @ARRAY@(47)=$SELECT(X]"":X,1:HLQ)
+172 ;Done - cleanup & quit
+173 DO KVA^VADPT
+174 QUIT
+175 ;
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
