Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VAFHLZPD

VAFHLZPD.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;
  1. ;ICRs
  1. ; Reference to NAME,^DI(.85 in ICR #6062
  1. ;
  1. EN(DFN,VAFSTR) ; This generic extrinsic function was designed to return
  1. ; sequences 1 throught 21 of the HL7 ZPD segment. This segment
  1. ; contains VA-specific patient information that is not contained in
  1. ; the HL7 PID segment. This call does not accomodate a segment
  1. ; length greater than 245 and has been superceeded by EN1^VAFHLZPD.
  1. ; This line tag has been left for backwards compatability.
  1. ;
  1. ;Input - DFN as internal entry number of the PATIENT file
  1. ; - VAFSTR as the string of fields requested seperated by commas
  1. ; (Defaults to all fields)
  1. ;
  1. ; *****Also assumes all HL7 variables returned from*****
  1. ; INIT^HLTRANS are defined.
  1. ;
  1. ;Output - String of data forming the ZPD segment.
  1. ;
  1. ;
  1. N VAFY,VAFZPD,REMARKS
  1. S VAFY=$$EN1($G(DFN),$G(VAFSTR))
  1. ;Segment less than 245 characters
  1. I ('$D(VAFZPD(1))) D
  1. . ;Remove sequences 22 and higher
  1. . S VAFY=$P(VAFY,HLFS,1,22)
  1. ;Segment greater than 245 characters
  1. I ($D(VAFZPD(1))) D
  1. . ;Strip out REMARKS (seq 2)
  1. . S REMARKS=$P(VAFY,HLFS,3)
  1. . S $P(VAFY,HLFS,3)=""
  1. . ;Append up to sequence 21 (PRIMARY CARE TEAM)
  1. . S VAFY=VAFY_$P(VAFZPD(1),HLFS,1,((21-$L(VAFY,HLFS))+2))
  1. . ;Place REMARKS back into segment, truncating if needed
  1. . S $P(VAFY,HLFS,3)=$E(REMARKS,1,(245-$L(VAFY)))
  1. ;Done
  1. Q VAFY
  1. ;
  1. EN1(DFN,VAFSTR) ; This generic extrinsic function was designed to return the
  1. ; HL7 ZPD segment. This segment contains VA-specific patient
  1. ; information that is not contained in the HL7 PID segment. This
  1. ; call superceeds EN^VAFHLZPD because it accomodates a segment
  1. ; length greater than 245.
  1. ;
  1. ;
  1. ;Input : DFN - Pointer to PATIENT file (#2)
  1. ; VAFSTR - List of data elements to retrieve seperated
  1. ; by commas (ex: 1,2,3)
  1. ; - Defaults to all data elements
  1. ; Existance of HL7 encoding variables is assumed
  1. ; (HLFS, HLENC, HLQ)
  1. ;Output : ZPD segment
  1. ; : If the ZPD segment becomes longer than 245 characters,
  1. ; remaining fields will be placed in VAFZPD(1)
  1. ;Notes : Sequence 1 (Set ID) will always have a value of '1'
  1. ; : A ZPD segment with sequence one set to '1' will be returned
  1. ; if DFN is not valid
  1. ; : Variable VAFZPD is initialized on entry
  1. ;
  1. ;Declare variables
  1. N VAFHLZPD,VAFY,SEQ,SPILL,SPILLON,SPOT,LASTSEQ,MAXLEN
  1. K VAFZPD
  1. S MAXLEN=245
  1. ;Get data
  1. D GETDATA($G(DFN),$G(VAFSTR),"VAFHLZPD")
  1. ;Build segment
  1. S VAFY="VAFHLZPD"
  1. S SPILL=0
  1. S SPILLON=0
  1. S @VAFY="ZPD"
  1. S LASTSEQ=+$O(VAFHLZPD(""),-1)
  1. F SEQ=1:1:LASTSEQ D
  1. . ;Make sure maximum length won't be exceeded
  1. . I ($L(@VAFY)+$L($G(VAFHLZPD(SEQ)))+1)>MAXLEN D
  1. . . ;Max length exceeded - start putting data on next node
  1. . . S SPILL=SPILL+1
  1. . . S SPILLON=SEQ-1
  1. . . S VAFY=$NA(VAFZPD(SPILL))
  1. . ;Add to string
  1. . S SPOT=(SEQ+1)-SPILLON
  1. . S $P(@VAFY,HLFS,SPOT)=$G(VAFHLZPD(SEQ))
  1. ;Return segment
  1. Q VAFHLZPD
  1. ;
  1. GETDATA(DFN,VAFSTR,ARRAY) ;Get info needed to build segment
  1. ;Input : DFN - Pointer to PATIENT file (#2)
  1. ; VAFSTR - List of data elements to retrieve seperated
  1. ; by commas (ex: 1,2,3)
  1. ; - Defaults to all data elements
  1. ; ARRAY - Array to return data in (full global reference)
  1. ; Defaults to ^TMP($J,"VAFHLZPD")
  1. ; Existance of HL7 encoding variables is assumed
  1. ; (HLFS, HLENC, HLQ)
  1. ;Output : Nothing
  1. ; ARRAY(SeqNum) = Value
  1. ;Notes : ARRAY is initialized (KILLed) on entry
  1. ; : Sequence 1 (Set ID) will always have a value of '1'
  1. ;
  1. ;Check input
  1. S ARRAY=$G(ARRAY)
  1. S:(ARRAY="") ARRAY=$NA(^TMP($J,"VAFHLZPD"))
  1. K @ARRAY
  1. ;Sequence 1 - Set ID
  1. ; value is always '1'
  1. S @ARRAY@(1)=1
  1. S DFN=+$G(DFN)
  1. S VAFSTR=$G(VAFSTR)
  1. ;DG*5.3*1085 - Include sequence numbers for Preferred Language and Preferred Language Date/Time
  1. ;S:(VAFSTR="") VAFSTR=$$COMMANUM(1,40)
  1. S:(VAFSTR="") VAFSTR=$$COMMANUM(1,47)
  1. S VAFSTR=","_VAFSTR_","
  1. ;Declare variables
  1. N VAFNODE,VAPD,X1,X
  1. ;Get zero node
  1. S VAFNODE=$G(^DPT(DFN,0))
  1. ;Get other patient data from VADPT
  1. D OPD^VADPT
  1. ;Sequence 2 - Remarks (truncate to 60 characters)
  1. I VAFSTR[",2," S X=$P(VAFNODE,"^",10),@ARRAY@(2)=$S(X="":HLQ,1:$E(X,1,60))
  1. ;Sequence 3 - Place of birth (city)
  1. I VAFSTR[",3," S @ARRAY@(3)=$S(VAPD(1)]"":VAPD(1),1:HLQ)
  1. ;Sequence 4 - Place of birth (State abbrv.)
  1. I VAFSTR[",4," S X1=$P($G(^DIC(5,$P(+VAPD(2),"^",1),0)),"^",2),@ARRAY@(4)=$S(X1]"":X1,1:HLQ)
  1. ;Sequence 5 - Current means test status
  1. I VAFSTR[",5," S X=$P(VAFNODE,"^",14),X1=$P($G(^DG(408.32,+X,0)),"^",2),@ARRAY@(5)=$S(X1]"":X1,1:HLQ)
  1. ;Sequence 6 - Fathers name
  1. I VAFSTR[",6," S @ARRAY@(6)=$S(VAPD(3)]"":VAPD(3),1:HLQ)
  1. ;Sequence 7 - Mothers name
  1. I VAFSTR[",7," S @ARRAY@(7)=$S(VAPD(4)]"":VAPD(4),1:HLQ)
  1. ;Sequence 8 - Rated incompetent
  1. I VAFSTR[",8," S X1=$$YN^VAFHLFNC($P($G(^DPT(DFN,.29)),"^",12)),@ARRAY@(8)=$S(X1]"":X1,1:HLQ)
  1. ;Sequence 9 - Date of Death
  1. I VAFSTR[",9," S X=$P($G(^DPT(DFN,.35)),"^",1),X1=$$HLDATE^HLFNC(X),@ARRAY@(9)=$S(X1]"":X1,1:HLQ)
  1. ;Sequence 10 - Collateral sponser name
  1. I VAFSTR[10 D
  1. . S X=$P($G(^DPT(DFN,.36)),"^",11)
  1. . S X1=$P($G(^DPT(+X,0)),"^",1)
  1. . S @ARRAY@(10)=$S(X1]"":X1,1:HLQ)
  1. ;Sequence 11 - Active Health Insurance?
  1. I VAFSTR[11 S X=$$INS^VAFHLFNC(DFN),X1=$$YN^VAFHLFNC(X),@ARRAY@(11)=$S(X1]"":X1,1:HLQ)
  1. ;Sequences 12 & 13
  1. I VAFSTR[12!(VAFSTR[13) D
  1. . S X=$G(^DPT(DFN,.38))
  1. . ;Sequence 12 - Eligible for Medicaid
  1. . I VAFSTR[12 S X1=$$YN^VAFHLFNC($P(X,"^",1)),@ARRAY@(12)=$S(X1]"":X1,1:HLQ)
  1. . ;Sequence 13 - Date Medicaid last asked
  1. . I VAFSTR[13 S X1=$$HLDATE^HLFNC($P(X,"^",2)),@ARRAY@(13)=$S(X1]"":X1,1:HLQ)
  1. ;Sequence 14 - Race
  1. I VAFSTR[14 S X=$P(VAFNODE,"^",6) S X1=$P($G(^DIC(10,+X,0)),"^",2),@ARRAY@(14)=$S(X1]"":X1,1:HLQ)
  1. ;Sequence 15 - Religious Preference
  1. I VAFSTR[15 S X=$P(VAFNODE,"^",8) S X1=$P($G(^DIC(13,+X,0)),"^",4),@ARRAY@(15)=$S(X1]"":X1,1:HLQ)
  1. ;Sequence 16 - Homeless Indicator
  1. ;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
  1. I VAFSTR[16 S @ARRAY@(16)=$S($$BADADR^DGUTL3(DFN)=2:1,1:0) ;DG 1002 uses different API call for Homeless Indicator
  1. ;Sequences 17 & 20
  1. I ((VAFSTR[17)!(VAFSTR[20)) D
  1. . ;POW Status & Location
  1. . N VAF52,POW,LOC
  1. . S VAF52=$G(^DPT(DFN,.52))
  1. . ;POW Status Indicated?
  1. . S POW=$P(VAF52,"^",5)
  1. . S:(POW="") POW=HLQ
  1. . ;POW Confinement Location (translates pointer to coded value)
  1. . S LOC=$P(VAF52,"^",6)
  1. . S:(LOC="") LOC=HLQ
  1. . I (LOC'=HLQ) S LOC=$S(LOC>0&(LOC<7):LOC+3,LOC>6&(LOC<9):$C(LOC+58),1:"")
  1. . ;Add to output array
  1. . ;Sequence 17 - POW Status
  1. . S:(VAFSTR[17) @ARRAY@(17)=POW
  1. . ;Sequence 20 - POW Confinement Location
  1. . S:(VAFSTR[20) @ARRAY@(20)=LOC
  1. ;Sequence 18 - Insurance Type
  1. I VAFSTR[18 S X=+$$INSTYP^IBCNS1(DFN),@ARRAY@(18)=$S(X]"":X,1:HLQ)
  1. ;Sequence 19 - RX Copay Exemption Status
  1. I VAFSTR[19 S X=+$$RXST^IBARXEU(DFN),@ARRAY@(19)=$S(X'<0:X,1:HLQ)
  1. ;Sequence 21 - Primary Care Team
  1. I (VAFSTR[21) D
  1. . ;Get Primary Care Team (as defined in PCMM)
  1. . S X=$$PCTEAM^DGSDUTL(DFN)
  1. . S X=$P(X,"^",2)
  1. . S:(X="") X=HLQ
  1. . ;Put into output array
  1. . S @ARRAY@(21)=X
  1. ;
  1. ; Sequences 22 thru 30 added by DG*5.3*264 (Smart Card)
  1. ;
  1. ; Sequences 22 & 23
  1. I VAFSTR[22!(VAFSTR[23) D
  1. . ; GI Insurance
  1. . S X=$G(^DPT(DFN,.362))
  1. . I VAFSTR[22 S X1=$P(X,U,17),@ARRAY@(22)=$S(X1="U":"N",X1]"":X1,1:HLQ)
  1. . I VAFSTR[23 S X1=$P(X,U,6),@ARRAY@(23)=$S(X1:$E(X1,1,6),1:HLQ)
  1. ; Sequences 24 through 27
  1. I VAFSTR[24!(VAFSTR[25)!(VAFSTR[26)!(VAFSTR[27) D
  1. . ; Most recent care dates & locations
  1. . S X=$G(^DPT(DFN,1010.15))
  1. . I VAFSTR[24 S X1=$$HLDATE^HLFNC($P(X,U)),@ARRAY@(24)=$S(X1]"":X1,1:HLQ)
  1. . I VAFSTR[25 S X1=$P(X,U,2),X1=$P($G(^DIC(4,+X1,0)),U),@ARRAY@(25)=$S(X1]"":X1,1:HLQ)
  1. . I VAFSTR[26 S X1=$$HLDATE^HLFNC($P(X,U,3)),@ARRAY@(26)=$S(X1]"":X1,1:HLQ)
  1. . I VAFSTR[27 S X1=$P(X,U,4),X1=$P($G(^DIC(4,+X1,0)),U),@ARRAY@(27)=$S(X1]"":X1,1:HLQ)
  1. ; Sequences 28 & 29
  1. I VAFSTR[28!(VAFSTR[29) D
  1. . ; dates ruled incompetent (civil and VA)
  1. . S X=$G(^DPT(DFN,.29))
  1. . I VAFSTR[28 S X1=$$HLDATE^HLFNC($P(X,U,2)),@ARRAY@(28)=$S(X1]"":X1,1:HLQ)
  1. . I VAFSTR[29 S X1=$$HLDATE^HLFNC($P(X,U)),@ARRAY@(29)=$S(X1]"":X1,1:HLQ)
  1. ; Sequence 30 - Spinal cord injury
  1. I VAFSTR[30 S X=$P($G(^DPT(DFN,57)),U,4),@ARRAY@(30)=$S(X]"":X,1:HLQ)
  1. ; Sequence 31 - Source of Notification
  1. I VAFSTR[9&(VAFSTR[31) S X=$P($G(^DPT(DFN,.35)),U,3),@ARRAY@(31)=$S(X]"":X,1:HLQ)
  1. ; Sequence 32 - Date/Time Last Updated
  1. 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)
  1. ; Sequence 33 - Filipino Veteran Proof
  1. I VAFSTR[33 S X=$P($G(^DPT(DFN,.321)),U,14),@ARRAY@(33)=$S(X]"":X,1:HLQ)
  1. ; Sequence 34 - Pseudo SSN Reason - Veteran
  1. I VAFSTR[34 S X=$P($G(^DPT(DFN,"SSN")),U),@ARRAY@(34)=$S(X]"":X,1:HLQ)
  1. ; Sequence 35 - Agency/Allied Country
  1. 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)
  1. ; Sequence 40 - Emergency Response Indicator
  1. I VAFSTR[40 S X=$P($G(^DPT(DFN,.18)),U),@ARRAY@(40)=$S(X]"":X,1:HLQ)
  1. ; KUM - DG*5.3*1064 - MegaBus Changes
  1. ; Sequence 41 - VOA Attachments Indicator - Not used - Added to make sure Seq 42 to 45 communication to ES
  1. I VAFSTR[41 S X="",@ARRAY@(41)=$S(X]"":X,1:HLQ)
  1. ;
  1. ; KUM - DG*5.3*1093 - Making null value for 42, 43, 44, 45
  1. I VAFSTR[42 S @ARRAY@(42)=HLQ
  1. I VAFSTR[43 S @ARRAY@(43)=HLQ
  1. I VAFSTR[44 S @ARRAY@(44)=HLQ
  1. I VAFSTR[45 S @ARRAY@(45)=HLQ
  1. ;N VAFINDARR
  1. ;D GETS^DIQ(2,DFN,".571:.574","I","VAFINDARR")
  1. ; Sequence 42 - Indian Self Identification
  1. ;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)
  1. ; Sequence 43 - Indian Attestation Date
  1. ;I VAFSTR[43 S X=VAFINDARR(2,DFN_",",.573,"I"),X1=$$HLDATE^HLFNC(X),@ARRAY@(43)=$S(X1]"":X1,1:HLQ)
  1. ; Sequence 44 - Indian Start Date
  1. ;I VAFSTR[44 S X=VAFINDARR(2,DFN_",",.572,"I"),X1=$$HLDATE^HLFNC(X),@ARRAY@(44)=$S(X1]"":X1,1:HLQ)
  1. ; Sequence 45 - Indian End Date
  1. ;I VAFSTR[45 S X=VAFINDARR(2,DFN_",",.574,"I"),X1=$$HLDATE^HLFNC(X),@ARRAY@(45)=$S(X1]"":X1,1:HLQ)
  1. ; DG*5.3*1085
  1. ; Retrieve Preferred Language and Preferred Language Date/Time
  1. N DGDATE,DGDA,DGLANGNM,DGLANGDT,DG85IEN
  1. S DGLANGDT="",DGLANGNM="",DG85IEN=""
  1. S DGDATE="",DGDATE=$O(^DPT(DFN,.207,"B",DGDATE),-1) Q:DGDATE=""
  1. I DGDATE'="" S DGDA=$O(^DPT(DFN,.207,"B",DGDATE,0))
  1. I DGDA'="" D
  1. .S DGLANGNM=$$GET1^DIQ(2.07,DGDA_","_DFN_",",.02)
  1. .S DGLANGDT=$$GET1^DIQ(2.07,DGDA_","_DFN_",",.01,"I")
  1. .I DGLANGNM="DECLINED TO ANSWER" S DGLANGNM="888" Q
  1. .I DGLANGNM="NO PREFERENCE" S DGLANGNM="999" Q
  1. .S DG85IEN=$$FIND1^DIC(.85,,"B",DGLANGNM)
  1. .I DG85IEN'="" S DGLANGNM=$$GET1^DIQ(.85,DG85IEN_",",.03)
  1. ; Sequence 46 - Preferred Language
  1. I VAFSTR[46 S X=DGLANGNM,@ARRAY@(46)=$S(X]"":X,1:HLQ)
  1. ; Sequence 47 - Preferred Language Update Date/Time
  1. I VAFSTR[47 S X=$$HLDATE^HLFNC(DGLANGDT),@ARRAY@(47)=$S(X]"":X,1:HLQ)
  1. ;Done - cleanup & quit
  1. D KVA^VADPT
  1. Q
  1. ;
  1. COMMANUM(FROM,TO) ;Build comma seperated list of numbers
  1. ;Input : FROM - Starting number (default = 1)
  1. ; TO - Ending number (default = FROM)
  1. ;Output : Comma seperated list of numbers between FROM and TO
  1. ; (Ex: 1,2,3)
  1. ;Notes : Call assumes FROM <= TO
  1. ;
  1. S FROM=$G(FROM) S:(FROM="") FROM=1
  1. S TO=$G(TO) S:(TO="") TO=FROM
  1. N OUTPUT,X
  1. S OUTPUT=FROM
  1. F X=(FROM+1):1:TO S OUTPUT=(OUTPUT_","_X)
  1. Q OUTPUT