source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VAFHLDG1.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.6 KB
Line 
1VAFHLDG1 ;ALB/CM/ESD HL7 DG1 SEGMENT BUILDING ; 3/24/05 5:05pm
2 ;;5.3;Registration;**94,151,190,511,606,614**;Aug 13, 1993
3 ;Routine currently being changed by GRR/EDS
4 ;IN entry is being added
5 ;
6 ;This routine will build an HL7 DG1 segment for an inpatient or
7 ;outpatient event depending on the entry point used.
8 ;Use IN for inpatient
9 ;Use OUT for outpatient
10 ;
11IN(DFN,VAFHMIEN,VAFSTR,VAOUT,VAFHMDT) ;
12 ;Input parameters
13 ;DFN - Patient's Internal Entry Number
14 ;VAFHMIEN - Internal Entry Number of Movement
15 ;VAFSTR - Sequence numbers of segment to include
16 ;VAOUT - Variable name where output segments should be saved
17 ;
18 K @VAOUT ;Insure output array is empty
19 Q:VAFHMIEN=""
20 N VAFHLREC,VAFHAIEN,VAFHICD
21 S $P(VAFHLREC,HL("FS"))="DG1" ;Set the segment identifier
22 S VAFHMDT=$$GET1^DIQ(405,VAFHMIEN,".01","I") ;Movement Date/Time
23 S VAFHTT=$$GET1^DIQ(405,VAFHMIEN,".02","I") ;Get the movement transaction type (admit, transfer, disharge)
24 I VAFHTT=1 S VAFHAIEN=VAFHMIEN ;If 'admit' movement capture ien
25 I VAFHTT'=1 S VAFHAIEN=$$GET1^DIQ(405,VAFHMIEN,".14","I") ;If not 'admit' movement, get ien of admission movement
26 Q:VAFHAIEN="" ;Quit if no admission movement
27 S VAFHADT=$$GET1^DIQ(405,VAFHAIEN,".01","I") ;Get Admission date/time
28 S VAFHPTF=$O(^DGPT("AAD",DFN,VAFHADT,"")) Q:VAFHPTF="" ;Get pointer to ptf record and quit if none exists
29 S VACNT=0 ;Initialize counter
30 ;I VAFHTT'=3 D ;If not a 'discharge' type, get Movement ICD codes and descriptions
31 ;.S DGLMR=$P($G(^DGPT(VAFHPTF,"M",0)),"^",3) ;Get Last movement ien
32 ;.Q:DGLMR="" ;Quit if no movement entry
33 ;.S DIQ="DGAM",DIQ(0)="I",DIC=45,DR=50,DA=VAFHPTF,DR(45.02)="5:15",DA(45.02)=DGLMR D EN^DIQ1 ;Retrieve the movement ICD fields
34 ;.I $D(DGAM(45.02,DGLMR)) D ;If ICD data exists
35 ;..F VAFLD=5,6,7,8,9,11,12,13,14,15 I $G(DGAM(45.02,DGLMR,VAFLD,"I"))]"" S VACNT=VACNT+1,VAFHICD(VACNT)=DGAM(45.02,DGLMR,VAFLD,"I") ;Check each ICD field for data and store in array if data exists
36 ;I VAFHTT=3 D ;If movement 'discharge' type, get ICD codes and descriptions from discharge data
37 F VAFLD=79,79.16:.01:79.19,79.201,79.21:.01:79.24,79.241,79.242,79.243,79.244 D
38 . S VAFHICD=$$GET1^DIQ(45,VAFHPTF,VAFLD,"I")
39 . I VAFHICD]"" S VACNT=VACNT+1,VAFHICD(VACNT)=VAFHICD ;Check each ICD field for data and store in array if data exists
40 I $O(VAFHICD(0))="" Q ;Quit if no data in ICD array
41 S VACNT=0 F S VACNT=$O(VAFHICD(VACNT)) Q:VACNT="" D ;If array contains ICD data
42 .S $P(VAFHLREC,HL("FS"))="DG1" ;Set segment type to DG1
43 .S $P(VAFHLREC,HL("FS"),2)=VACNT ;Set Segment Set ID to next sequential number
44 .I VAFSTR[",2," S $P(VAFHLREC,HL("FS"),3)="I9" ;Set 'Diagnosis Coding Method' to reflect ICD9
45 .I VAFSTR[",3," S $P(VAFHLREC,HL("FS"),4)=$$GET1^DIQ(80,VAFHICD(VACNT),".01","I")_$E(HL("ECH"))_$P($$ICDDX^ICDCODE(VAFHICD(VACNT),VAFHMDT),"^",4) ;Icd Code and Description
46 .I VAFSTR[",5," S $P(VAFHLREC,HL("FS"),6)=$$HLDATE^HLFNC(VAFHMDT) ;Diagnosis Date/Time set to Movement Date/Time
47 .S @VAOUT@(VACNT,0)=VAFHLREC ;Set next node of ICD output array to the newly created segment
48 Q
49 ;
50 ;
51OUT(DFN,EVT,EVDTS,VPTR,STRP,NUMP) ;
52 ;DFN - Patient File
53 ;EVT - event number from pivot file
54 ;EVDTS - event date/time FileMan
55 ;VPTR - variable pointer
56 ;STRP - string of fields
57 ;(if null - required fields, if "A" - supported
58 ;fields, or string of fields seperated by commas")
59 ;NUMP - ID # (optional)
60 ;
61 N ERR
62 I '$D(NUMP) S NUMP=1
63 S ERR=$$ODG1^VAFHCDG($G(DFN),$G(EVT),$G(EVDTS),$G(VPTR),$G(STRP),NUMP)
64 Q ERR
65 ;
66 ;
67EN(VAFENC,VAFSTR,VAFHLQ,VAFHLFS,VAFARRY) ; Entry point for Ambulatory Care Database Project
68 ; - Entry point to return the HL7 DG1 segment
69 ;
70 ; This function will create VA-specific DG1 segment(s) for a
71 ; given outpatient encounter. The DG1 segment is designed to transfer
72 ; generic information about an outpatient diagnosis or diagnoses.
73 ;
74 ; Input: VAFENC - IEN of the Outpatient Encounter (#409.68) file
75 ; VAFSTR - String of fields requested separated by commas
76 ; VAFHLQ - Optional HL7 null variable. If not there, use
77 ; default HL7 variable
78 ; VAFHLFS - Optional HL7 field separator. If not there, use
79 ; default HL7 variable
80 ; VAFARRY - Optional user-supplied array name to hold the HL7 DG1 segments
81 ;
82 ; Output: Array of HL7 DG1 segments
83 ;
84 ;
85 N I,VAFDICDE,VAFIDX,VAFNODE,VAFDNODE,VAFY,VAXY,X,ICDVDT
86 S VAFARRY=$G(VAFARRY),ICDVDT=$$SCE^DGSDU(VAFENC,1,0)
87 ;
88 ; - If VAFARRY not defined, use ^TMP("VAFHL",$J,"DIAGNOSIS")
89 S:(VAFARRY="") VAFARRY="^TMP(""VAFHL"",$J,""DIAGNOSIS"")"
90 ;
91 ; - If VAFHLQ or VAFHLFS aren't passed in, use default HL7 variables
92 S VAFHLQ=$S($D(VAFHLQ):VAFHLQ,1:$G(HLQ)),VAFHLFS=$S($D(VAFHLFS):VAFHLFS,1:$G(HLFS))
93 I '$G(VAFENC)!($G(VAFSTR)']"") S @VAFARRY@(1,0)="DG1"_VAFHLFS_1 G ENQ
94 S VAFIDX=0,VAFSTR=","_VAFSTR_","
95 ;
96 ; - Get all outpatient diagnoses for encounter
97 D GETDX^SDOE(VAFENC,"VAXY")
98 ;
99 ; - Set diagnosis array to 0 if no outpatient diagnosis for encounter
100 I '$G(VAXY) S VAXY(1)=0
101 ;
102ALL ; -- All outpatient diagnoses for encounter
103 ;
104 ; -- only send dx once per encounter / build ok array
105 N VAOK
106 F I=0:0 S I=$O(VAXY(I)) Q:'I D
107 . S VAFNODE=VAXY(I)
108 . ;
109 . ; -- if this is first entry for dx then 'ok' it
110 . IF '$D(VAOK(+VAFNODE)) S VAOK(+VAFNODE)=I Q
111 . ;
112 . ; -- if primary then 'ok' it (if two are primary we 'ok' last)
113 . IF $P(VAFNODE,U,12)="P" S VAOK(+VAFNODE)=I
114 ;
115 ;
116 F I=0:0 S I=$O(VAXY(I)) Q:'I D
117 .;
118 .S VAFNODE=VAXY(I)
119 .;
120 .; - build array of HL7 (DG1) segments but only use ok'ed entry for dx
121 .IF $G(VAOK(+VAFNODE))=I D BUILD
122 ;
123ENQ Q
124 ;
125 ;
126BUILD ; - Build array of HL7 (DG1) segments
127 S $P(VAFY,VAFHLFS,16)="",VAFIDX=VAFIDX+1
128 S VAFDICDE="I9" ; Diagnosis Coding Method = I9 (ICD-9)
129 ;
130 ; - Sequential number (required field)
131 S $P(VAFY,VAFHLFS,1)=VAFIDX
132 ;
133 I VAFSTR[",2," S $P(VAFY,VAFHLFS,2)=$S($G(VAFDICDE)]"":VAFDICDE,1:VAFHLQ) ; Diagnosis Coding Method = ICD-9
134 ;I (VAFSTR[",3,")!(VAFSTR[",4,") S VAFDNODE=$G(^ICD9(+$G(VAFNODE),0)) ; Get node from ICD Diagnosis file
135 I (VAFSTR[",3,")!(VAFSTR[",4,") S VAFDNODE=$$ICDDX^ICDCODE(+VAFNODE,$G(ICDVDT)) ; Get node from ICD Diagnosis file
136 I VAFSTR[",3," S X=$P($G(VAFDNODE),"^",2),$P(VAFY,VAFHLFS,3)=$S(X]"":X,1:VAFHLQ) ; Diagnosis Code
137 I VAFSTR[",4," S X=$P($G(VAFDNODE),"^",4),$P(VAFY,VAFHLFS,4)=$S(X]"":X,1:VAFHLQ) ; Diagnosis Description
138 I VAFSTR[",5," S X=$$HLDATE^HLFNC($$SCE^DGSDU(VAFENC,1,0)),$P(VAFY,VAFHLFS,5)=$S(X]"":X,1:VAFHLQ) ; Diagnosis Date/Time (Encounter Date/Time)
139 ;
140 ; - Contains 1 if primary diagnosis, blank otherwise
141 I VAFSTR[",15," S X=$P($G(VAFNODE),"^",12),$P(VAFY,VAFHLFS,15)=$S(X="P":1,1:VAFHLQ) ; Diagnosis Ranking Number
142 ;
143 ; - Set all outpatient diagnoses into array
144 S @VAFARRY@(VAFIDX,0)="DG1"_VAFHLFS_$G(VAFY)
145 Q
Note: See TracBrowser for help on using the repository browser.