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

VAFHAPV1.m

Go to the documentation of this file.
  1. VAFHAPV1 ;ALB/RJS - INPATIENT PV1 SEGMENT ; 1/11/10 1:43pm
  1. ;;5.3;Registration;**91,209,190,298,494,621,823**;Aug 13, 1993;Build 6
  1. ;
  1. ;The DGBUILD entry point is call used internally by MAS software
  1. ;to build a PV1 Segment for deleted Admissions. The DGPMP
  1. ;variable, available from the DGPM Event Driver at the time of
  1. ;the deletion, makes it possible to construct a partial PV1 segment
  1. ;for the deleted record.
  1. ;
  1. ;06/29/00 ACS - Added sequence 21 (physical treating specialty - ward
  1. ;location) and sequence 39 (facility + suffix).
  1. ;
  1. EN(DFN,VAFHDT,VAFSTR,IEN,ALTVISID,SETID,VAFDIAG) ;
  1. ;
  1. ;This Entry Point builds the HL7 PV1 segment for inpatients.
  1. ;
  1. ;DFN, VAFHDT, & VAFSTR are the required variables.
  1. ;
  1. ; DFN = IEN of Patient File
  1. ; VAFHDT = Date/Time of Patient Movement
  1. ; VAFSTR = HL7 Fields Requested e.g. ",3,7,10"
  1. ;
  1. ;IEN, ALTVISID, SETID are the optional variables
  1. ;
  1. ;The optional variable IEN is used for Discharge movements
  1. ;because if only Date/Time is passed for a Discharge movement
  1. ;no useful information is returned by VADPT.
  1. ;
  1. ;The optional ALTVISID variable is used to pass in a "Alternate.
  1. ;Visit ID" this is a unique number that
  1. ;identifies this Admission or episode of care
  1. ;
  1. ;The optional variable SETID can be used to differentiate
  1. ;different sets of data, in messages that may contain multiple
  1. ;events or messages.
  1. ;
  1. ;VAFDIAG, is a passed as a dotted variable. The inpatient diagnosis
  1. ;is then returned in this variable.
  1. ;
  1. N VAFCOMP,RESULT,VAROOT,VA200
  1. N CURRENT
  1. ;Make sure the VAFSTR string is correctly formatted (",#,#,...,#,") DG*823
  1. I $E(VAFSTR,1)'="," S VAFSTR=","_VAFSTR
  1. I $E(VAFSTR,$L(VAFSTR))'="," S VAFSTR=VAFSTR_","
  1. ;
  1. D KVAR^VADPT
  1. S VAFCOMP=$E(HLECH,1)
  1. S VAROOT="CURRENT",VAIP("D")=VAFHDT,VA200=1
  1. I ($G(IEN)'="") S VAIP("E")=IEN
  1. D IN5^VADPT
  1. S RESULT=$$BUILD()
  1. I $G(ALTVISID)'="" S $P(RESULT,HLFS,51)=ALTVISID
  1. I $G(SETID)'="" S $P(RESULT,HLFS,2)=SETID
  1. I $G(SETID)="" S $P(RESULT,HLFS,2)=1
  1. ;
  1. EXIT ;
  1. Q $G(RESULT)
  1. ;
  1. BUILD() ;Build the PV1 Segment
  1. ;
  1. ;Required Variables: Array "CURRENT" containing the results
  1. ; of a call to VADPT
  1. ;
  1. ;This entry point is called to build the HL7 PV1 segment from
  1. ;data returned by VADPT
  1. ;
  1. ;It returns a fully encoded HL7 segment, or a partially encoded HL7 segment containing patient class only
  1. ;
  1. N RESULT,SUBS
  1. S RESULT="PV1"_HLFS_HLFS_"I"
  1. I $G(CURRENT(1))="" Q RESULT
  1. I $G(CURRENT(1))'="" D
  1. . S VAFDIAG=CURRENT(9)
  1. . ;
  1. . ;--Ward, Room, Bed
  1. . ;
  1. . ;Format all If statements to be the same (I VAFSTR[",#,") DG*823
  1. . I VAFSTR[",3," D
  1. . . N WARD,ROOM,BED
  1. . . S WARD=$$HLQ^VAFHUTL($P(CURRENT(5),"^",2))
  1. . . S ROOM=$$HLQ^VAFHUTL($P($P(CURRENT(6),"^",2),"-",1))
  1. . . S BED=$$HLQ^VAFHUTL($P($P(CURRENT(6),"^",2),"-",2))
  1. . . S $P(RESULT,HLFS,4)=$G(WARD)_VAFCOMP_$G(ROOM)_VAFCOMP_$G(BED)
  1. . ;
  1. . ;--Attending Physician
  1. . ;
  1. . I VAFSTR[",7," D
  1. . . N ATTNDPTR,ATTNDING
  1. . . S ATTNDPTR=$P(CURRENT(18),"^",1)
  1. . . ;S:ATTNDPTR'="" ATTNDING=$$HLNAME^HLFNC($P(CURRENT(18),"^",2))
  1. . . I $G(ATTNDPTR)'="" D
  1. . . . N DGNAME S DGNAME("FILE")=200,DGNAME("IENS")=ATTNDPTR,DGNAME("FIELD")=.01
  1. . . . S ATTNDING=$$HLNAME^XLFNAME(.DGNAME,"S",$E($G(HLECH)))
  1. . . S $P(RESULT,HLFS,8)=$$HLQ^VAFHUTL($G(ATTNDPTR))_VAFCOMP_$$HLQ^VAFHUTL($G(ATTNDING))
  1. . ;
  1. . ;--Treating Specialty
  1. . ;
  1. . I VAFSTR[",10," D
  1. . . N SPECPTR,SPECALTY
  1. . . S SPECPTR=$P(CURRENT(8),"^",1)
  1. . . S:$G(SPECPTR)'="" SPECALTY=$P($G(^DIC(45.7,SPECPTR,0)),"^",2)
  1. . . S $P(RESULT,HLFS,11)=$$HLQ^VAFHUTL($G(SPECALTY))
  1. . ;
  1. . ;--Previous Patient Location
  1. . I VAFSTR[",6," D
  1. . . N WARD,ROOM,BED,ROOMPTR,ROOMBED,MOVEMENT
  1. . . S WARD=$$HLQ^VAFHUTL($P(CURRENT(15,4),"^",2))
  1. . . S MOVEMENT=$G(CURRENT(15))
  1. . . I MOVEMENT D
  1. . . . S ROOMPTR=$P(^DGPM(MOVEMENT,0),"^",7)
  1. . . . I ROOMPTR D
  1. . . . . S ROOMBED=$P(^DG(405.4,ROOMPTR,0),"^",1)
  1. . . . . I (ROOMBED'="") D
  1. . . . . . S ROOM=$P(ROOMBED,"-",1)
  1. . . . . . S BED=$P(ROOMBED,"-",2)
  1. . . S $P(RESULT,HLFS,7)=$$HLQ^VAFHUTL($G(WARD))_VAFCOMP_$$HLQ^VAFHUTL($G(ROOM))_VAFCOMP_$$HLQ^VAFHUTL($G(BED))
  1. . ;
  1. . ;-- Patient Type
  1. . I VAFSTR[",18," D
  1. . .I +$G(^DPT(DFN,"TYPE")) DO
  1. . . .S $P(RESULT,HLFS,19)=$P($G(^DG(391,+^("TYPE"),0)),"^",1)
  1. . .E S $P(RESULT,HLFS,19)=HLQ
  1. . ;
  1. . ;--Physical Treating Specialty - Ward Location
  1. . ;
  1. . I VAFSTR[",21," D
  1. . . N VAWARD,VAPHYTS
  1. . . ; get ward location pointer
  1. . . S VAWARD=$P($G(CURRENT(5)),"^",1) Q:VAWARD=""
  1. . . ; get ward treating specialty pointer
  1. . . S VAPHYTS=$P($G(^DIC(42,VAWARD,0)),"^",12)
  1. . . S $P(RESULT,HLFS,22)=$S(VAPHYTS]"":VAPHYTS,1:HLQ)
  1. . . Q
  1. . ;
  1. . ;--Facility and Suffix
  1. . I VAFSTR[",39," D
  1. . . N VAFIEN,VAWARD,VAMEDCTR,VAFACSUF
  1. . . ; get patient movement IEN, ward loc ptr, med center div ptr
  1. . . S VAFIEN=$G(CURRENT(1))
  1. . . S VAWARD=$P($G(^DGPM(VAFIEN,0)),"^",6) Q:VAWARD=""
  1. . . S VAMEDCTR=$P($G(^DIC(42,VAWARD,0)),"^",11) Q:VAMEDCTR=""
  1. . . ; call below returns: inst pointer^inst name^station number w/suffix
  1. . . S VAFACSUF=$$SITE^VASITE($G(CURRENT(3)),VAMEDCTR)
  1. . . S VAFACSUF=$P(VAFACSUF,"^",3)
  1. . . ; move data into the PV1 segment
  1. . . S $P(RESULT,HLFS,40)=$S(VAFACSUF]"":VAFACSUF,1:HLQ)
  1. . ;
  1. . ;Discharge Disposition
  1. . I VAFSTR[",36," D ;If Discharge Disposition requested
  1. . .N DGDTYP
  1. . .S DGDTYP=$P(CURRENT(17,3),"^") S $P(RESULT,HLFS,37)=DGDTYP
  1. . ;
  1. . ;--Admission Date
  1. . ;
  1. . I (VAFSTR[",44,") D
  1. . . I ($P(CURRENT(13,1),"^",1)'="") S $P(RESULT,HLFS,45)=$$HLDATE^HLFNC($P(CURRENT(13,1),"^",1),"TS")
  1. . . E S $P(RESULT,HLFS,45)=HLQ
  1. . ;
  1. . ;
  1. . ;--Discharge Date
  1. . ;
  1. . I (VAFSTR[",45,") D
  1. . . I ($P(CURRENT(17,1),"^",1)'="") S $P(RESULT,HLFS,46)=$$HLDATE^HLFNC($P(CURRENT(17,1),"^",1),"TS")
  1. . . E S $P(RESULT,HLFS,46)=HLQ
  1. ;
  1. Q:$$TEST(7,RESULT,HLFS,VAFCOMP) RESULT
  1. Q RESULT
  1. DGBUILD(DGPMP,VAFSTR) ;
  1. ;
  1. ;Required Variables: DGPMP = 0 node of patient movement
  1. ; VAFSTR = HL7 fields requested e.g.
  1. ; ",3,7,10"
  1. ;
  1. ;This entry point builds an HL7 segment from data supplied
  1. ;from the 0 node of the Patient movement file in the required
  1. ;variable DGPMP. It is an internal PIMS call used to build
  1. ;a PV1 segment when the record has already been deleted.
  1. ;
  1. ;The call returns a fully encoded PV1 segment or a partially encoded
  1. ;PV1 segment containing only set id and patient class
  1. ;
  1. N WARD,BED,ROOM,ATTNDPTR,ATTNDING,SPECPTR,SPECALTY,TRANSACT
  1. N ADMPTR,ADMSSN,VAFCOMP,RESULT
  1. ;Check to have string follow correct format (",#,#,...,#,") DG*823
  1. I $E(VAFSTR,1)'="," S VAFSTR=","_VAFSTR
  1. I $E(VAFSTR,$L(VAFSTR))'="," S VAFSTR=VAFSTR_","
  1. S RESULT="PV1"_HLFS_1_HLFS_"I" ;Inpatient
  1. I $G(DGPMP)="" Q RESULT
  1. S TRANSACT=$P(DGPMP,"^",2),VAFCOMP=$E(HLECH,1)
  1. I TRANSACT=1 S VAFDIAG=$P(DGPMP,"^",10)
  1. E S ADMPTR=$P(DGPMP,"^",14),ADMSSN=$G(^DGPM(ADMPTR,0)),VAFDIAG=$P(ADMSSN,"^",10)
  1. ;
  1. ;--Ward, Room, Bed
  1. ;
  1. ;Make sure all IF statements carry same logic (I VAFSTR[",#,") DG*823
  1. I VAFSTR[",3," D
  1. . N WARD,ROOM,BED
  1. . ;
  1. . ;--Check node 2 to see if it's a discharge movement
  1. . ;
  1. . ;
  1. . I TRANSACT=3 D
  1. . . S $P(RESULT,HLFS,4)=HLQ_VAFCOMP_HLQ_VAFCOMP_HLQ
  1. . . ;
  1. . . ;--All non discharge events are handled the same
  1. . . ;
  1. . I TRANSACT'=3 D
  1. . . N WARDPTR,ROOMPTR,ROOM,WARD,BED
  1. . . S WARDPTR=$P(DGPMP,"^",6)
  1. . . S ROOMPTR=$P(DGPMP,"^",7)
  1. . . I $G(WARDPTR)'="" S WARD=$P(^DIC(42,WARDPTR,0),"^",1)
  1. . . I $G(ROOMPTR)'="" D
  1. . . . S ROOM=$P(^DG(405.4,ROOMPTR,0),"^",1)
  1. . . . S BED=$P(ROOM,"-",2)
  1. . . . S ROOM=$P(ROOM,"-",1)
  1. . . S $P(RESULT,HLFS,4)=$$HLQ^VAFHUTL($G(WARD))_VAFCOMP_$$HLQ^VAFHUTL($G(ROOM))_VAFCOMP_$$HLQ^VAFHUTL($G(BED))
  1. . ;
  1. . ;--Attending Physician
  1. . ;
  1. I VAFSTR[",7," D
  1. . N ATTNDPTR,ATTNDING
  1. . S ATTNDPTR=$P(DGPMP,"^",19)
  1. . I $G(ATTNDPTR)'="" D
  1. . . N DGNAME S DGNAME("FILE")=200,DGNAME("IENS")=ATTNDPTR,DGNAME("FIELD")=.01
  1. . . S ATTNDING=$$HLNAME^XLFNAME(.DGNAME,"S",$E($G(HLECH)))
  1. . S $P(RESULT,HLFS,8)=$$HLQ^VAFHUTL($G(ATTNDPTR))_VAFCOMP_$$HLQ^VAFHUTL($G(ATTNDING))
  1. . ;
  1. . ;--Treating Specialty
  1. . ;
  1. I VAFSTR[",10," D
  1. . N SPECPTR,SPECALTY
  1. . S SPECPTR=$P(DGPMP,"^",9)
  1. . I $G(SPECPTR)'="" S SPECALTY=$P($G(^DIC(45.7,SPECPTR,0)),"^",2)
  1. . S $P(RESULT,HLFS,11)=$$HLQ^VAFHUTL($G(SPECALTY))
  1. ;
  1. ;-- Patient Type
  1. I VAFSTR[",18," D
  1. . I +$G(^DPT(DFN,"TYPE")) DO
  1. . . S $P(RESULT,HLFS,19)=$P($G(^DG(391,+^("TYPE"),0)),"^",1)
  1. . E S $P(RESULT,HLFS,19)=HLQ
  1. ;
  1. ;--Physical Treating Specialty - Ward Location
  1. ;
  1. I VAFSTR[",21," D
  1. . N VAWARD,VAPHYTS
  1. . ; get ward location pointer
  1. . S VAWARD=$P($G(DGPMP),"^",6) Q:VAWARD=""
  1. . ; get ward treating specialty
  1. . S VAPHYTS=$P($G(^DIC(42,VAWARD,0)),"^",12)
  1. . S $P(RESULT,HLFS,22)=$S(VAPHYTS]"":VAPHYTS,1:HLQ)
  1. . Q
  1. ;
  1. ;--Facility and Suffix
  1. ;
  1. N VAWARD,VAMEDCTR,VAFACSUF
  1. I VAFSTR[",39," D
  1. . ; get ward location pointer, med center div pointer
  1. . S $P(RESULT,HLFS,40)=HLQ
  1. . S VAWARD=$P($G(DGPMP),"^",6) Q:VAWARD=""
  1. . S VAMEDCTR=$P($G(^DIC(42,VAWARD,0)),"^",11) Q:VAMEDCTR=""
  1. . ; call below returns: inst pointer^inst name^station number w/suffix
  1. . S VAFACSUF=$$SITE^VASITE($P(DGPMP,"^",1),VAMEDCTR)
  1. . S VAFACSUF=$P(VAFACSUF,"^",3)
  1. . ; move data into the PV1 segment
  1. . S $P(RESULT,HLFS,40)=$S(VAFACSUF]"":VAFACSUF,1:HLQ)
  1. ;
  1. ;Discharge Disposition
  1. ;
  1. I VAFSTR[",36," D ;If Discharge Disposition requested
  1. . N DGDTYP
  1. . S DGDTYP=$P($G(DGPMP),"^",18) ;Discharge type pointer in movement file
  1. . S $P(RESULT,HLFS,37)=DGDTYP ;store in variable
  1. ;
  1. ;--Admission Date
  1. ;
  1. I (VAFSTR[",44,") D
  1. . I $P(DGPMP,"^",1)="" S $P(RESULT,HLFS,45)=HLQ
  1. . E S $P(RESULT,HLFS,45)=$$HLDATE^HLFNC($P(DGPMP,"^",1),"TS")
  1. ;
  1. Q:$$TEST(8,RESULT,HLFS,VAFCOMP) RESULT
  1. Q RESULT
  1. TEST(COUNTER,STRING,FIELDSEP,COMPNENT) ;
  1. N CHAR,LENGTH
  1. S LENGTH=$L(STRING)
  1. NEXT ;
  1. I COUNTER>LENGTH Q 0
  1. S CHAR=$E(STRING,COUNTER,COUNTER)
  1. I $G(CHAR)=FIELDSEP!($G(CHAR)=COMPNENT) S COUNTER=COUNTER+1 G NEXT
  1. Q 1