- 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 Jan 18, 2025@04:04:17 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