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

VAFHLDG1.m

Go to the documentation of this file.
  1. 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
  1. ; Reference to $$CSI^ICDEX supported by ICR #5747
  1. ; Reference to $$ICDDX^ICDEX supported by ICR #5747
  1. ;Routine currently being changed by GRR/EDS
  1. ;IN entry is being added
  1. ;
  1. ;This routine will build an HL7 DG1 segment for an inpatient or
  1. ;outpatient event depending on the entry point used.
  1. ;Use IN for inpatient
  1. ;Use OUT for outpatient
  1. ;
  1. IN(DFN,VAFHMIEN,VAFSTR,VAOUT,VAFHMDT) ;
  1. ;Input parameters
  1. ;DFN - Patient's Internal Entry Number
  1. ;VAFHMIEN - Internal Entry Number of Movement
  1. ;VAFSTR - Sequence numbers of segment to include
  1. ;VAOUT - Variable name where output segments should be saved
  1. ;
  1. K @VAOUT ;Insure output array is empty
  1. Q:VAFHMIEN=""
  1. N VAFHLREC,VAFHAIEN,VAFHICD
  1. S $P(VAFHLREC,HL("FS"))="DG1" ;Set the segment identifier
  1. S VAFHMDT=$$GET1^DIQ(405,VAFHMIEN,".01","I") ;Movement Date/Time
  1. S VAFHTT=$$GET1^DIQ(405,VAFHMIEN,".02","I") ;Get the movement transaction type (admit, transfer, discharge)
  1. I VAFHTT=1 S VAFHAIEN=VAFHMIEN ;If 'admit' movement capture ien
  1. I VAFHTT'=1 S VAFHAIEN=$$GET1^DIQ(405,VAFHMIEN,".14","I") ;If not 'admit' movement, get ien of admission movement
  1. Q:VAFHAIEN="" ;Quit if no admission movement
  1. S VAFHADT=$$GET1^DIQ(405,VAFHAIEN,".01","I") ;Get Admission date/time
  1. S VAFHPTF=$O(^DGPT("AAD",DFN,VAFHADT,"")) Q:VAFHPTF="" ;Get pointer to ptf record and quit if none exists
  1. S VACNT=0 ;Initialize counter
  1. F VAFLD=79,79.16:.01:79.19,79.201,79.21:.01:79.24,79.241,79.242,79.243,79.244 D
  1. . S VAFHICD=$$GET1^DIQ(45,VAFHPTF,VAFLD,"I")
  1. . I VAFHICD]"" S VACNT=VACNT+1,VAFHICD(VACNT)=VAFHICD ;Check each ICD field for data and store in array if data exists
  1. I $O(VAFHICD(0))="" Q ;Quit if no data in ICD array
  1. S VACNT=0 F S VACNT=$O(VAFHICD(VACNT)) Q:VACNT="" D ;If array contains ICD data
  1. .S $P(VAFHLREC,HL("FS"))="DG1" ;Set segment type to DG1
  1. .S $P(VAFHLREC,HL("FS"),2)=VACNT ;Set Segment Set ID to next sequential number
  1. .I VAFSTR[",2," S $P(VAFHLREC,HL("FS"),3)="I9" ;Set 'Diagnosis Coding Method' to reflect ICD9
  1. .I VAFSTR[",3," D
  1. .. 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
  1. .I VAFSTR[",5," S $P(VAFHLREC,HL("FS"),6)=$$HLDATE^HLFNC(VAFHMDT) ;Diagnosis Date/Time set to Movement Date/Time
  1. .S @VAOUT@(VACNT,0)=VAFHLREC ;Set next node of ICD output array to the newly created segment
  1. Q
  1. ;
  1. ;
  1. OUT(DFN,EVT,EVDTS,VPTR,STRP,NUMP) ;
  1. ;DFN - Patient File
  1. ;EVT - event number from pivot file
  1. ;EVDTS - event date/time FileMan
  1. ;VPTR - variable pointer
  1. ;STRP - string of fields
  1. ;(if null - required fields, if "A" - supported
  1. ;fields, or string of fields separated by commas")
  1. ;NUMP - ID # (optional)
  1. ;
  1. N ERR
  1. I '$D(NUMP) S NUMP=1
  1. S ERR=$$ODG1^VAFHCDG($G(DFN),$G(EVT),$G(EVDTS),$G(VPTR),$G(STRP),NUMP)
  1. Q ERR
  1. ;
  1. ;
  1. EN(VAFENC,VAFSTR,VAFHLQ,VAFHLFS,VAFARRY) ; Entry point for Ambulatory Care Database Project
  1. ; - Entry point to return the HL7 DG1 segment
  1. ;
  1. ; This function will create VA-specific DG1 segment(s) for a
  1. ; given outpatient encounter. The DG1 segment is designed to transfer
  1. ; generic information about an outpatient diagnosis or diagnoses.
  1. ;
  1. ; Input: VAFENC - IEN of the Outpatient Encounter (#409.68) file
  1. ; VAFSTR - String of fields requested separated by commas
  1. ; VAFHLQ - Optional HL7 null variable. If not there, use
  1. ; default HL7 variable
  1. ; VAFHLFS - Optional HL7 field separator. If not there, use
  1. ; default HL7 variable
  1. ; VAFARRY - Optional user-supplied array name to hold the HL7 DG1 segments
  1. ;
  1. ; Output: Array of HL7 DG1 segments
  1. ;
  1. ;
  1. N I,VAFIDX,VAFNODE,VAFDNODE,VAFY,VAXY,X,ICDVDT
  1. S VAFARRY=$G(VAFARRY),ICDVDT=$$SCE^DGSDU(VAFENC,1,0)
  1. ;
  1. ; - If VAFARRY not defined, use ^TMP("VAFHL",$J,"DIAGNOSIS")
  1. S:(VAFARRY="") VAFARRY="^TMP(""VAFHL"",$J,""DIAGNOSIS"")"
  1. ;
  1. ; - If VAFHLQ or VAFHLFS aren't passed in, use default HL7 variables
  1. S VAFHLQ=$S($D(VAFHLQ):VAFHLQ,1:$G(HLQ)),VAFHLFS=$S($D(VAFHLFS):VAFHLFS,1:$G(HLFS))
  1. I '$G(VAFENC)!($G(VAFSTR)']"") S @VAFARRY@(1,0)="DG1"_VAFHLFS_1 G ENQ
  1. S VAFIDX=0,VAFSTR=","_VAFSTR_","
  1. ;
  1. ; - Get all outpatient diagnoses for encounter
  1. D GETDX^SDOE(VAFENC,"VAXY")
  1. ;
  1. ; - Set diagnosis array to 0 if no outpatient diagnosis for encounter
  1. I '$G(VAXY) S VAXY(1)=0
  1. ;
  1. ALL ; -- All outpatient diagnoses for encounter
  1. ;
  1. ; -- only send dx once per encounter / build ok array
  1. N VAOK
  1. F I=0:0 S I=$O(VAXY(I)) Q:'I D
  1. . S VAFNODE=VAXY(I)
  1. . ;
  1. . ; -- if this is first entry for dx then 'ok' it
  1. . IF '$D(VAOK(+VAFNODE)) S VAOK(+VAFNODE)=I Q
  1. . ;
  1. . ; -- if primary then 'ok' it (if two are primary we 'ok' last)
  1. . IF $P(VAFNODE,U,12)="P" S VAOK(+VAFNODE)=I
  1. ;
  1. ;
  1. F I=0:0 S I=$O(VAXY(I)) Q:'I D
  1. .;
  1. .S VAFNODE=VAXY(I)
  1. .;
  1. .; - build array of HL7 (DG1) segments but only use ok'ed entry for dx
  1. .IF $G(VAOK(+VAFNODE))=I D BUILD
  1. ;
  1. ENQ Q
  1. ;
  1. ;
  1. BUILD ; - Build array of HL7 (DG1) segments
  1. S $P(VAFY,VAFHLFS,16)="",VAFIDX=VAFIDX+1
  1. ;
  1. ; - Sequential number (required field)
  1. S $P(VAFY,VAFHLFS,1)=VAFIDX
  1. ;
  1. I (VAFSTR[",2,")!(VAFSTR[",3,")!(VAFSTR[",4,") S VAFDNODE=$$ICDDX^ICDEX(+VAFNODE,$G(ICDVDT),$$CSI^ICDEX(80,+VAFNODE),"I")
  1. I VAFSTR[",2," S X=$P($G(VAFDNODE),"^",20),$P(VAFY,VAFHLFS,2)=$S(X=30:"I10",1:"I9")
  1. I VAFSTR[",3," S X=$P($G(VAFDNODE),"^",2),$P(VAFY,VAFHLFS,3)=$S(X]"":X,1:VAFHLQ) ; Diagnosis Code
  1. I VAFSTR[",4," S X=$P($G(VAFDNODE),"^",4),$P(VAFY,VAFHLFS,4)=$S(X]"":X,1:VAFHLQ) ; Diagnosis Description
  1. 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)
  1. ;
  1. ; - Contains 1 if primary diagnosis, blank otherwise
  1. I VAFSTR[",15," S X=$P($G(VAFNODE),"^",12),$P(VAFY,VAFHLFS,15)=$S(X="P":1,1:VAFHLQ) ; Diagnosis Ranking Number
  1. ;
  1. ; - Set all outpatient diagnoses into array
  1. S @VAFARRY@(VAFIDX,0)="DG1"_VAFHLFS_$G(VAFY)
  1. Q