VAFHLDG1 ;ALB/CM/ESD HL7 DG1 SEGMENT BUILDING ; 3/24/05 5:05pm
;;5.3;Registration;**94,151,190,511,606,614,1015**;Aug 13, 1993;Build 21
;Routine currently being changed by GRR/EDS
;IN entry is being added
;
;This routine will build an HL7 DG1 segment for an inpatient or
;outpatient event depending on the entry point used.
;Use IN for inpatient
;Use OUT for outpatient
;
IN(DFN,VAFHMIEN,VAFSTR,VAOUT,VAFHMDT) ;
;Input parameters
;DFN - Patient's Internal Entry Number
;VAFHMIEN - Internal Entry Number of Movement
;VAFSTR - Sequence numbers of segment to include
;VAOUT - Variable name where output segments should be saved
;
K @VAOUT ;Insure output array is empty
Q:VAFHMIEN=""
N VAFHLREC,VAFHAIEN,VAFHICD
S $P(VAFHLREC,HL("FS"))="DG1" ;Set the segment identifier
S VAFHMDT=$$GET1^DIQ(405,VAFHMIEN,".01","I") ;Movement Date/Time
S VAFHTT=$$GET1^DIQ(405,VAFHMIEN,".02","I") ;Get the movement transaction type (admit, transfer, disharge)
I VAFHTT=1 S VAFHAIEN=VAFHMIEN ;If 'admit' movement capture ien
I VAFHTT'=1 S VAFHAIEN=$$GET1^DIQ(405,VAFHMIEN,".14","I") ;If not 'admit' movement, get ien of admission movement
Q:VAFHAIEN="" ;Quit if no admission movement
S VAFHADT=$$GET1^DIQ(405,VAFHAIEN,".01","I") ;Get Admission date/time
S VAFHPTF=$O(^DGPT("AAD",DFN,VAFHADT,"")) Q:VAFHPTF="" ;Get pointer to ptf record and quit if none exists
S VACNT=0 ;Initialize counter
;I VAFHTT'=3 D ;If not a 'discharge' type, get Movement ICD codes and descriptions
;.S DGLMR=$P($G(^DGPT(VAFHPTF,"M",0)),"^",3) ;Get Last movement ien
;.Q:DGLMR="" ;Quit if no movement entry
;.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
;.I $D(DGAM(45.02,DGLMR)) D ;If ICD data exists
;..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
;I VAFHTT=3 D ;If movement 'discharge' type, get ICD codes and descriptions from discharge data
F VAFLD=79,79.16:.01:79.19,79.201,79.21:.01:79.24,79.241,79.242,79.243,79.244 D
. S VAFHICD=$$GET1^DIQ(45,VAFHPTF,VAFLD,"I")
. I VAFHICD]"" S VACNT=VACNT+1,VAFHICD(VACNT)=VAFHICD ;Check each ICD field for data and store in array if data exists
I $O(VAFHICD(0))="" Q ;Quit if no data in ICD array
S VACNT=0 F S VACNT=$O(VAFHICD(VACNT)) Q:VACNT="" D ;If array contains ICD data
.S $P(VAFHLREC,HL("FS"))="DG1" ;Set segment type to DG1
.S $P(VAFHLREC,HL("FS"),2)=VACNT ;Set Segment Set ID to next sequential number
.I VAFSTR[",2," S $P(VAFHLREC,HL("FS"),3)="I9" ;Set 'Diagnosis Coding Method' to reflect ICD9
.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
.I VAFSTR[",5," S $P(VAFHLREC,HL("FS"),6)=$$HLDATE^HLFNC(VAFHMDT) ;Diagnosis Date/Time set to Movement Date/Time
.S @VAOUT@(VACNT,0)=VAFHLREC ;Set next node of ICD output array to the newly created segment
Q
;
;
OUT(DFN,EVT,EVDTS,VPTR,STRP,NUMP) ;
;DFN - Patient File
;EVT - event number from pivot file
;EVDTS - event date/time FileMan
;VPTR - variable pointer
;STRP - string of fields
;(if null - required fields, if "A" - supported
;fields, or string of fields seperated by commas")
;NUMP - ID # (optional)
;
N ERR
I '$D(NUMP) S NUMP=1
S ERR=$$ODG1^VAFHCDG($G(DFN),$G(EVT),$G(EVDTS),$G(VPTR),$G(STRP),NUMP)
Q ERR
;
;
EN(VAFENC,VAFSTR,VAFHLQ,VAFHLFS,VAFARRY) ; Entry point for Ambulatory Care Database Project
; - Entry point to return the HL7 DG1 segment
;
; This function will create VA-specific DG1 segment(s) for a
; given outpatient encounter. The DG1 segment is designed to transfer
; generic information about an outpatient diagnosis or diagnoses.
;
; Input: VAFENC - IEN of the Outpatient Encounter (#409.68) file
; VAFSTR - String of fields requested separated by commas
; VAFHLQ - Optional HL7 null variable. If not there, use
; default HL7 variable
; VAFHLFS - Optional HL7 field separator. If not there, use
; default HL7 variable
; VAFARRY - Optional user-supplied array name to hold the HL7 DG1 segments
;
; Output: Array of HL7 DG1 segments
;
;
N I,VAFDICDE,VAFIDX,VAFNODE,VAFDNODE,VAFY,VAXY,X,ICDVDT
S VAFARRY=$G(VAFARRY),ICDVDT=$$SCE^DGSDU(VAFENC,1,0)
;
; - If VAFARRY not defined, use ^TMP("VAFHL",$J,"DIAGNOSIS")
S:(VAFARRY="") VAFARRY="^TMP(""VAFHL"",$J,""DIAGNOSIS"")"
;
; - If VAFHLQ or VAFHLFS aren't passed in, use default HL7 variables
S VAFHLQ=$S($D(VAFHLQ):VAFHLQ,1:$G(HLQ)),VAFHLFS=$S($D(VAFHLFS):VAFHLFS,1:$G(HLFS))
I '$G(VAFENC)!($G(VAFSTR)']"") S @VAFARRY@(1,0)="DG1"_VAFHLFS_1 G ENQ
S VAFIDX=0,VAFSTR=","_VAFSTR_","
;
; - Get all outpatient diagnoses for encounter
D GETDX^SDOE(VAFENC,"VAXY")
;
; - Set diagnosis array to 0 if no outpatient diagnosis for encounter
I '$G(VAXY) S VAXY(1)=0
;
ALL ; -- All outpatient diagnoses for encounter
;
; -- only send dx once per encounter / build ok array
N VAOK
F I=0:0 S I=$O(VAXY(I)) Q:'I D
. S VAFNODE=VAXY(I)
. ;
. ; -- if this is first entry for dx then 'ok' it
. IF '$D(VAOK(+VAFNODE)) S VAOK(+VAFNODE)=I Q
. ;
. ; -- if primary then 'ok' it (if two are primary we 'ok' last)
. IF $P(VAFNODE,U,12)="P" S VAOK(+VAFNODE)=I
;
;
F I=0:0 S I=$O(VAXY(I)) Q:'I D
.;
.S VAFNODE=VAXY(I)
.;
.; - build array of HL7 (DG1) segments but only use ok'ed entry for dx
.IF $G(VAOK(+VAFNODE))=I D BUILD
;
ENQ Q
;
;
BUILD ; - Build array of HL7 (DG1) segments
S $P(VAFY,VAFHLFS,16)="",VAFIDX=VAFIDX+1
S VAFDICDE="I9" ; Diagnosis Coding Method = I9 (ICD-9)
;
; - Sequential number (required field)
S $P(VAFY,VAFHLFS,1)=VAFIDX
;
I VAFSTR[",2," S $P(VAFY,VAFHLFS,2)=$S($G(VAFDICDE)]"":VAFDICDE,1:VAFHLQ) ; Diagnosis Coding Method = ICD-9
;I (VAFSTR[",3,")!(VAFSTR[",4,") S VAFDNODE=$G(^ICD9(+$G(VAFNODE),0)) ; Get node from ICD Diagnosis file
I (VAFSTR[",3,")!(VAFSTR[",4,") S VAFDNODE=$$ICDDX^ICDCODE(+VAFNODE,$G(ICDVDT)) ; Get node from ICD Diagnosis file
I VAFSTR[",3," S X=$P($G(VAFDNODE),"^",2),$P(VAFY,VAFHLFS,3)=$S(X]"":X,1:VAFHLQ) ; Diagnosis Code
I VAFSTR[",4," S X=$P($G(VAFDNODE),"^",4),$P(VAFY,VAFHLFS,4)=$S(X]"":X,1:VAFHLQ) ; Diagnosis Description
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)
;
; - Contains 1 if primary diagnosis, blank otherwise
I VAFSTR[",15," S X=$P($G(VAFNODE),"^",12),$P(VAFY,VAFHLFS,15)=$S(X="P":1,1:VAFHLQ) ; Diagnosis Ranking Number
;
; - Set all outpatient diagnoses into array
S @VAFARRY@(VAFIDX,0)="DG1"_VAFHLFS_$G(VAFY)
Q
VAFHLDG1 ;ALB/CM/ESD HL7 DG1 SEGMENT BUILDING ; 3/24/05 5:05pm
+1 ;;5.3;Registration;**94,151,190,511,606,614,1015**;Aug 13, 1993;Build 21
+2 ;Routine currently being changed by GRR/EDS
+3 ;IN entry is being added
+4 ;
+5 ;This routine will build an HL7 DG1 segment for an inpatient or
+6 ;outpatient event depending on the entry point used.
+7 ;Use IN for inpatient
+8 ;Use OUT for outpatient
+9 ;
IN(DFN,VAFHMIEN,VAFSTR,VAOUT,VAFHMDT) ;
+1 ;Input parameters
+2 ;DFN - Patient's Internal Entry Number
+3 ;VAFHMIEN - Internal Entry Number of Movement
+4 ;VAFSTR - Sequence numbers of segment to include
+5 ;VAOUT - Variable name where output segments should be saved
+6 ;
+7 ;Insure output array is empty
KILL @VAOUT
+8 IF VAFHMIEN=""
QUIT
+9 NEW VAFHLREC,VAFHAIEN,VAFHICD
+10 ;Set the segment identifier
SET $PIECE(VAFHLREC,HL("FS"))="DG1"
+11 ;Movement Date/Time
SET VAFHMDT=$$GET1^DIQ(405,VAFHMIEN,".01","I")
+12 ;Get the movement transaction type (admit, transfer, disharge)
SET VAFHTT=$$GET1^DIQ(405,VAFHMIEN,".02","I")
+13 ;If 'admit' movement capture ien
IF VAFHTT=1
SET VAFHAIEN=VAFHMIEN
+14 ;If not 'admit' movement, get ien of admission movement
IF VAFHTT'=1
SET VAFHAIEN=$$GET1^DIQ(405,VAFHMIEN,".14","I")
+15 ;Quit if no admission movement
IF VAFHAIEN=""
QUIT
+16 ;Get Admission date/time
SET VAFHADT=$$GET1^DIQ(405,VAFHAIEN,".01","I")
+17 ;Get pointer to ptf record and quit if none exists
SET VAFHPTF=$ORDER(^DGPT("AAD",DFN,VAFHADT,""))
IF VAFHPTF=""
QUIT
+18 ;Initialize counter
SET VACNT=0
+19 ;I VAFHTT'=3 D ;If not a 'discharge' type, get Movement ICD codes and descriptions
+20 ;.S DGLMR=$P($G(^DGPT(VAFHPTF,"M",0)),"^",3) ;Get Last movement ien
+21 ;.Q:DGLMR="" ;Quit if no movement entry
+22 ;.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
+23 ;.I $D(DGAM(45.02,DGLMR)) D ;If ICD data exists
+24 ;..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
+25 ;I VAFHTT=3 D ;If movement 'discharge' type, get ICD codes and descriptions from discharge data
+26 FOR VAFLD=79,79.16:.01:79.19,79.201,79.21:.01:79.24,79.241,79.242,79.243,79.244
Begin DoDot:1
+27 SET VAFHICD=$$GET1^DIQ(45,VAFHPTF,VAFLD,"I")
+28 ;Check each ICD field for data and store in array if data exists
IF VAFHICD]""
SET VACNT=VACNT+1
SET VAFHICD(VACNT)=VAFHICD
End DoDot:1
+29 ;Quit if no data in ICD array
IF $ORDER(VAFHICD(0))=""
QUIT
+30 ;If array contains ICD data
SET VACNT=0
FOR
SET VACNT=$ORDER(VAFHICD(VACNT))
IF VACNT=""
QUIT
Begin DoDot:1
+31 ;Set segment type to DG1
SET $PIECE(VAFHLREC,HL("FS"))="DG1"
+32 ;Set Segment Set ID to next sequential number
SET $PIECE(VAFHLREC,HL("FS"),2)=VACNT
+33 ;Set 'Diagnosis Coding Method' to reflect ICD9
IF VAFSTR[",2,"
SET $PIECE(VAFHLREC,HL("FS"),3)="I9"
+34 ;Icd Code and Description
IF VAFSTR[",3,"
SET $PIECE(VAFHLREC,HL("FS"),4)=$$GET1^DIQ(80,VAFHICD(VACNT),".01","I")_$EXTRACT(HL("ECH"))_$PIECE($$ICDDX^ICDCODE(VAFHICD(VACNT),VAFHMDT),"^",4)
+35 ;Diagnosis Date/Time set to Movement Date/Time
IF VAFSTR[",5,"
SET $PIECE(VAFHLREC,HL("FS"),6)=$$HLDATE^HLFNC(VAFHMDT)
+36 ;Set next node of ICD output array to the newly created segment
SET @VAOUT@(VACNT,0)=VAFHLREC
End DoDot:1
+37 QUIT
+38 ;
+39 ;
OUT(DFN,EVT,EVDTS,VPTR,STRP,NUMP) ;
+1 ;DFN - Patient File
+2 ;EVT - event number from pivot file
+3 ;EVDTS - event date/time FileMan
+4 ;VPTR - variable pointer
+5 ;STRP - string of fields
+6 ;(if null - required fields, if "A" - supported
+7 ;fields, or string of fields seperated by commas")
+8 ;NUMP - ID # (optional)
+9 ;
+10 NEW ERR
+11 IF '$DATA(NUMP)
SET NUMP=1
+12 SET ERR=$$ODG1^VAFHCDG($GET(DFN),$GET(EVT),$GET(EVDTS),$GET(VPTR),$GET(STRP),NUMP)
+13 QUIT ERR
+14 ;
+15 ;
EN(VAFENC,VAFSTR,VAFHLQ,VAFHLFS,VAFARRY) ; Entry point for Ambulatory Care Database Project
+1 ; - Entry point to return the HL7 DG1 segment
+2 ;
+3 ; This function will create VA-specific DG1 segment(s) for a
+4 ; given outpatient encounter. The DG1 segment is designed to transfer
+5 ; generic information about an outpatient diagnosis or diagnoses.
+6 ;
+7 ; Input: VAFENC - IEN of the Outpatient Encounter (#409.68) file
+8 ; VAFSTR - String of fields requested separated by commas
+9 ; VAFHLQ - Optional HL7 null variable. If not there, use
+10 ; default HL7 variable
+11 ; VAFHLFS - Optional HL7 field separator. If not there, use
+12 ; default HL7 variable
+13 ; VAFARRY - Optional user-supplied array name to hold the HL7 DG1 segments
+14 ;
+15 ; Output: Array of HL7 DG1 segments
+16 ;
+17 ;
+18 NEW I,VAFDICDE,VAFIDX,VAFNODE,VAFDNODE,VAFY,VAXY,X,ICDVDT
+19 SET VAFARRY=$GET(VAFARRY)
SET ICDVDT=$$SCE^DGSDU(VAFENC,1,0)
+20 ;
+21 ; - If VAFARRY not defined, use ^TMP("VAFHL",$J,"DIAGNOSIS")
+22 IF (VAFARRY="")
SET VAFARRY="^TMP(""VAFHL"",$J,""DIAGNOSIS"")"
+23 ;
+24 ; - If VAFHLQ or VAFHLFS aren't passed in, use default HL7 variables
+25 SET VAFHLQ=$SELECT($DATA(VAFHLQ):VAFHLQ,1:$GET(HLQ))
SET VAFHLFS=$SELECT($DATA(VAFHLFS):VAFHLFS,1:$GET(HLFS))
+26 IF '$GET(VAFENC)!($GET(VAFSTR)']"")
SET @VAFARRY@(1,0)="DG1"_VAFHLFS_1
GOTO ENQ
+27 SET VAFIDX=0
SET VAFSTR=","_VAFSTR_","
+28 ;
+29 ; - Get all outpatient diagnoses for encounter
+30 DO GETDX^SDOE(VAFENC,"VAXY")
+31 ;
+32 ; - Set diagnosis array to 0 if no outpatient diagnosis for encounter
+33 IF '$GET(VAXY)
SET VAXY(1)=0
+34 ;
ALL ; -- All outpatient diagnoses for encounter
+1 ;
+2 ; -- only send dx once per encounter / build ok array
+3 NEW VAOK
+4 FOR I=0:0
SET I=$ORDER(VAXY(I))
IF 'I
QUIT
Begin DoDot:1
+5 SET VAFNODE=VAXY(I)
+6 ;
+7 ; -- if this is first entry for dx then 'ok' it
+8 IF '$DATA(VAOK(+VAFNODE))
SET VAOK(+VAFNODE)=I
QUIT
+9 ;
+10 ; -- if primary then 'ok' it (if two are primary we 'ok' last)
+11 IF $PIECE(VAFNODE,U,12)="P"
SET VAOK(+VAFNODE)=I
End DoDot:1
+12 ;
+13 ;
+14 FOR I=0:0
SET I=$ORDER(VAXY(I))
IF 'I
QUIT
Begin DoDot:1
+15 ;
+16 SET VAFNODE=VAXY(I)
+17 ;
+18 ; - build array of HL7 (DG1) segments but only use ok'ed entry for dx
+19 IF $GET(VAOK(+VAFNODE))=I
DO BUILD
End DoDot:1
+20 ;
ENQ QUIT
+1 ;
+2 ;
BUILD ; - Build array of HL7 (DG1) segments
+1 SET $PIECE(VAFY,VAFHLFS,16)=""
SET VAFIDX=VAFIDX+1
+2 ; Diagnosis Coding Method = I9 (ICD-9)
SET VAFDICDE="I9"
+3 ;
+4 ; - Sequential number (required field)
+5 SET $PIECE(VAFY,VAFHLFS,1)=VAFIDX
+6 ;
+7 ; Diagnosis Coding Method = ICD-9
IF VAFSTR[",2,"
SET $PIECE(VAFY,VAFHLFS,2)=$SELECT($GET(VAFDICDE)]"":VAFDICDE,1:VAFHLQ)
+8 ;I (VAFSTR[",3,")!(VAFSTR[",4,") S VAFDNODE=$G(^ICD9(+$G(VAFNODE),0)) ; Get node from ICD Diagnosis file
+9 ; Get node from ICD Diagnosis file
IF (VAFSTR[",3,")!(VAFSTR[",4,")
SET VAFDNODE=$$ICDDX^ICDCODE(+VAFNODE,$GET(ICDVDT))
+10 ; Diagnosis Code
IF VAFSTR[",3,"
SET X=$PIECE($GET(VAFDNODE),"^",2)
SET $PIECE(VAFY,VAFHLFS,3)=$SELECT(X]"":X,1:VAFHLQ)
+11 ; Diagnosis Description
IF VAFSTR[",4,"
SET X=$PIECE($GET(VAFDNODE),"^",4)
SET $PIECE(VAFY,VAFHLFS,4)=$SELECT(X]"":X,1:VAFHLQ)
+12 ; Diagnosis Date/Time (Encounter Date/Time)
IF VAFSTR[",5,"
SET X=$$HLDATE^HLFNC($$SCE^DGSDU(VAFENC,1,0))
SET $PIECE(VAFY,VAFHLFS,5)=$SELECT(X]"":X,1:VAFHLQ)
+13 ;
+14 ; - Contains 1 if primary diagnosis, blank otherwise
+15 ; Diagnosis Ranking Number
IF VAFSTR[",15,"
SET X=$PIECE($GET(VAFNODE),"^",12)
SET $PIECE(VAFY,VAFHLFS,15)=$SELECT(X="P":1,1:VAFHLQ)
+16 ;
+17 ; - Set all outpatient diagnoses into array
+18 SET @VAFARRY@(VAFIDX,0)="DG1"_VAFHLFS_$GET(VAFY)
+19 QUIT
