- VAFHLDG1 ;ALB/CM/ESD HL7 DG1 SEGMENT BUILDING ;3/24/05 5:05pm
- ;;5.3;Registration;**94,151,190,511,606,614,850**;Aug 13, 1993;Build 171
- ; Reference to $$CSI^ICDEX supported by ICR #5747
- ; Reference to $$ICDDX^ICDEX supported by ICR #5747
- ;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, discharge)
- 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
- 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," D
- .. S $P(VAFHLREC,HL("FS"),4)=$$GET1^DIQ(80,VAFHICD(VACNT),".01","I")_$E(HL("ECH"))_$P($$ICDDATA^ICDXCODE("DIAG",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 separated 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,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
- ;
- ; - Sequential number (required field)
- S $P(VAFY,VAFHLFS,1)=VAFIDX
- ;
- I (VAFSTR[",2,")!(VAFSTR[",3,")!(VAFSTR[",4,") S VAFDNODE=$$ICDDX^ICDEX(+VAFNODE,$G(ICDVDT),$$CSI^ICDEX(80,+VAFNODE),"I")
- I VAFSTR[",2," S X=$P($G(VAFDNODE),"^",20),$P(VAFY,VAFHLFS,2)=$S(X=30:"I10",1:"I9")
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFHLDG1 6164 printed Jan 18, 2025@04:03:37 Page 2
- VAFHLDG1 ;ALB/CM/ESD HL7 DG1 SEGMENT BUILDING ;3/24/05 5:05pm
- +1 ;;5.3;Registration;**94,151,190,511,606,614,850**;Aug 13, 1993;Build 171
- +2 ; Reference to $$CSI^ICDEX supported by ICR #5747
- +3 ; Reference to $$ICDDX^ICDEX supported by ICR #5747
- +4 ;Routine currently being changed by GRR/EDS
- +5 ;IN entry is being added
- +6 ;
- +7 ;This routine will build an HL7 DG1 segment for an inpatient or
- +8 ;outpatient event depending on the entry point used.
- +9 ;Use IN for inpatient
- +10 ;Use OUT for outpatient
- +11 ;
- 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, discharge)
- 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 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
- +20 SET VAFHICD=$$GET1^DIQ(45,VAFHPTF,VAFLD,"I")
- +21 ;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
- +22 ;Quit if no data in ICD array
- IF $ORDER(VAFHICD(0))=""
- QUIT
- +23 ;If array contains ICD data
- SET VACNT=0
- FOR
- SET VACNT=$ORDER(VAFHICD(VACNT))
- if VACNT=""
- QUIT
- Begin DoDot:1
- +24 ;Set segment type to DG1
- SET $PIECE(VAFHLREC,HL("FS"))="DG1"
- +25 ;Set Segment Set ID to next sequential number
- SET $PIECE(VAFHLREC,HL("FS"),2)=VACNT
- +26 ;Set 'Diagnosis Coding Method' to reflect ICD9
- IF VAFSTR[",2,"
- SET $PIECE(VAFHLREC,HL("FS"),3)="I9"
- +27 IF VAFSTR[",3,"
- Begin DoDot:2
- +28 ;Icd Code and Description
- SET $PIECE(VAFHLREC,HL("FS"),4)=$$GET1^DIQ(80,VAFHICD(VACNT),".01","I")_$EXTRACT(HL("ECH"))_$PIECE($$ICDDATA^ICDXCODE("DIAG",VAFHICD(VACNT),VAFHMDT),"^",4)
- End DoDot:2
- +29 ;Diagnosis Date/Time set to Movement Date/Time
- IF VAFSTR[",5,"
- SET $PIECE(VAFHLREC,HL("FS"),6)=$$HLDATE^HLFNC(VAFHMDT)
- +30 ;Set next node of ICD output array to the newly created segment
- SET @VAOUT@(VACNT,0)=VAFHLREC
- End DoDot:1
- +31 QUIT
- +32 ;
- +33 ;
- 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 separated 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,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 ;
- +3 ; - Sequential number (required field)
- +4 SET $PIECE(VAFY,VAFHLFS,1)=VAFIDX
- +5 ;
- +6 IF (VAFSTR[",2,")!(VAFSTR[",3,")!(VAFSTR[",4,")
- SET VAFDNODE=$$ICDDX^ICDEX(+VAFNODE,$GET(ICDVDT),$$CSI^ICDEX(80,+VAFNODE),"I")
- +7 IF VAFSTR[",2,"
- SET X=$PIECE($GET(VAFDNODE),"^",20)
- SET $PIECE(VAFY,VAFHLFS,2)=$SELECT(X=30:"I10",1:"I9")
- +8 ; Diagnosis Code
- IF VAFSTR[",3,"
- SET X=$PIECE($GET(VAFDNODE),"^",2)
- SET $PIECE(VAFY,VAFHLFS,3)=$SELECT(X]"":X,1:VAFHLQ)
- +9 ; Diagnosis Description
- IF VAFSTR[",4,"
- SET X=$PIECE($GET(VAFDNODE),"^",4)
- SET $PIECE(VAFY,VAFHLFS,4)=$SELECT(X]"":X,1:VAFHLQ)
- +10 ; 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)
- +11 ;
- +12 ; - Contains 1 if primary diagnosis, blank otherwise
- +13 ; Diagnosis Ranking Number
- IF VAFSTR[",15,"
- SET X=$PIECE($GET(VAFNODE),"^",12)
- SET $PIECE(VAFY,VAFHLFS,15)=$SELECT(X="P":1,1:VAFHLQ)
- +14 ;
- +15 ; - Set all outpatient diagnoses into array
- +16 SET @VAFARRY@(VAFIDX,0)="DG1"_VAFHLFS_$GET(VAFY)
- +17 QUIT