VAFHAPV1 ;ALB/RJS - INPATIENT PV1 SEGMENT ; 1/11/10 1:43pm
;;5.3;Registration;**91,209,190,298,494,621,823**;Aug 13, 1993;Build 6
;
;The DGBUILD entry point is call used internally by MAS software
;to build a PV1 Segment for deleted Admissions. The DGPMP
;variable, available from the DGPM Event Driver at the time of
;the deletion, makes it possible to construct a partial PV1 segment
;for the deleted record.
;
;06/29/00 ACS - Added sequence 21 (physical treating specialty - ward
;location) and sequence 39 (facility + suffix).
;
EN(DFN,VAFHDT,VAFSTR,IEN,ALTVISID,SETID,VAFDIAG) ;
;
;This Entry Point builds the HL7 PV1 segment for inpatients.
;
;DFN, VAFHDT, & VAFSTR are the required variables.
;
; DFN = IEN of Patient File
; VAFHDT = Date/Time of Patient Movement
; VAFSTR = HL7 Fields Requested e.g. ",3,7,10"
;
;IEN, ALTVISID, SETID are the optional variables
;
;The optional variable IEN is used for Discharge movements
;because if only Date/Time is passed for a Discharge movement
;no useful information is returned by VADPT.
;
;The optional ALTVISID variable is used to pass in a "Alternate.
;Visit ID" this is a unique number that
;identifies this Admission or episode of care
;
;The optional variable SETID can be used to differentiate
;different sets of data, in messages that may contain multiple
;events or messages.
;
;VAFDIAG, is a passed as a dotted variable. The inpatient diagnosis
;is then returned in this variable.
;
N VAFCOMP,RESULT,VAROOT,VA200
N CURRENT
;Make sure the VAFSTR string is correctly formatted (",#,#,...,#,") DG*823
I $E(VAFSTR,1)'="," S VAFSTR=","_VAFSTR
I $E(VAFSTR,$L(VAFSTR))'="," S VAFSTR=VAFSTR_","
;
D KVAR^VADPT
S VAFCOMP=$E(HLECH,1)
S VAROOT="CURRENT",VAIP("D")=VAFHDT,VA200=1
I ($G(IEN)'="") S VAIP("E")=IEN
D IN5^VADPT
S RESULT=$$BUILD()
I $G(ALTVISID)'="" S $P(RESULT,HLFS,51)=ALTVISID
I $G(SETID)'="" S $P(RESULT,HLFS,2)=SETID
I $G(SETID)="" S $P(RESULT,HLFS,2)=1
;
EXIT ;
Q $G(RESULT)
;
BUILD() ;Build the PV1 Segment
;
;Required Variables: Array "CURRENT" containing the results
; of a call to VADPT
;
;This entry point is called to build the HL7 PV1 segment from
;data returned by VADPT
;
;It returns a fully encoded HL7 segment, or a partially encoded HL7 segment containing patient class only
;
N RESULT,SUBS
S RESULT="PV1"_HLFS_HLFS_"I"
I $G(CURRENT(1))="" Q RESULT
I $G(CURRENT(1))'="" D
. S VAFDIAG=CURRENT(9)
. ;
. ;--Ward, Room, Bed
. ;
. ;Format all If statements to be the same (I VAFSTR[",#,") DG*823
. I VAFSTR[",3," D
. . N WARD,ROOM,BED
. . S WARD=$$HLQ^VAFHUTL($P(CURRENT(5),"^",2))
. . S ROOM=$$HLQ^VAFHUTL($P($P(CURRENT(6),"^",2),"-",1))
. . S BED=$$HLQ^VAFHUTL($P($P(CURRENT(6),"^",2),"-",2))
. . S $P(RESULT,HLFS,4)=$G(WARD)_VAFCOMP_$G(ROOM)_VAFCOMP_$G(BED)
. ;
. ;--Attending Physician
. ;
. I VAFSTR[",7," D
. . N ATTNDPTR,ATTNDING
. . S ATTNDPTR=$P(CURRENT(18),"^",1)
. . ;S:ATTNDPTR'="" ATTNDING=$$HLNAME^HLFNC($P(CURRENT(18),"^",2))
. . I $G(ATTNDPTR)'="" D
. . . N DGNAME S DGNAME("FILE")=200,DGNAME("IENS")=ATTNDPTR,DGNAME("FIELD")=.01
. . . S ATTNDING=$$HLNAME^XLFNAME(.DGNAME,"S",$E($G(HLECH)))
. . S $P(RESULT,HLFS,8)=$$HLQ^VAFHUTL($G(ATTNDPTR))_VAFCOMP_$$HLQ^VAFHUTL($G(ATTNDING))
. ;
. ;--Treating Specialty
. ;
. I VAFSTR[",10," D
. . N SPECPTR,SPECALTY
. . S SPECPTR=$P(CURRENT(8),"^",1)
. . S:$G(SPECPTR)'="" SPECALTY=$P($G(^DIC(45.7,SPECPTR,0)),"^",2)
. . S $P(RESULT,HLFS,11)=$$HLQ^VAFHUTL($G(SPECALTY))
. ;
. ;--Previous Patient Location
. I VAFSTR[",6," D
. . N WARD,ROOM,BED,ROOMPTR,ROOMBED,MOVEMENT
. . S WARD=$$HLQ^VAFHUTL($P(CURRENT(15,4),"^",2))
. . S MOVEMENT=$G(CURRENT(15))
. . I MOVEMENT D
. . . S ROOMPTR=$P(^DGPM(MOVEMENT,0),"^",7)
. . . I ROOMPTR D
. . . . S ROOMBED=$P(^DG(405.4,ROOMPTR,0),"^",1)
. . . . I (ROOMBED'="") D
. . . . . S ROOM=$P(ROOMBED,"-",1)
. . . . . S BED=$P(ROOMBED,"-",2)
. . S $P(RESULT,HLFS,7)=$$HLQ^VAFHUTL($G(WARD))_VAFCOMP_$$HLQ^VAFHUTL($G(ROOM))_VAFCOMP_$$HLQ^VAFHUTL($G(BED))
. ;
. ;-- Patient Type
. I VAFSTR[",18," D
. .I +$G(^DPT(DFN,"TYPE")) DO
. . .S $P(RESULT,HLFS,19)=$P($G(^DG(391,+^("TYPE"),0)),"^",1)
. .E S $P(RESULT,HLFS,19)=HLQ
. ;
. ;--Physical Treating Specialty - Ward Location
. ;
. I VAFSTR[",21," D
. . N VAWARD,VAPHYTS
. . ; get ward location pointer
. . S VAWARD=$P($G(CURRENT(5)),"^",1) Q:VAWARD=""
. . ; get ward treating specialty pointer
. . S VAPHYTS=$P($G(^DIC(42,VAWARD,0)),"^",12)
. . S $P(RESULT,HLFS,22)=$S(VAPHYTS]"":VAPHYTS,1:HLQ)
. . Q
. ;
. ;--Facility and Suffix
. I VAFSTR[",39," D
. . N VAFIEN,VAWARD,VAMEDCTR,VAFACSUF
. . ; get patient movement IEN, ward loc ptr, med center div ptr
. . S VAFIEN=$G(CURRENT(1))
. . S VAWARD=$P($G(^DGPM(VAFIEN,0)),"^",6) Q:VAWARD=""
. . S VAMEDCTR=$P($G(^DIC(42,VAWARD,0)),"^",11) Q:VAMEDCTR=""
. . ; call below returns: inst pointer^inst name^station number w/suffix
. . S VAFACSUF=$$SITE^VASITE($G(CURRENT(3)),VAMEDCTR)
. . S VAFACSUF=$P(VAFACSUF,"^",3)
. . ; move data into the PV1 segment
. . S $P(RESULT,HLFS,40)=$S(VAFACSUF]"":VAFACSUF,1:HLQ)
. ;
. ;Discharge Disposition
. I VAFSTR[",36," D ;If Discharge Disposition requested
. .N DGDTYP
. .S DGDTYP=$P(CURRENT(17,3),"^") S $P(RESULT,HLFS,37)=DGDTYP
. ;
. ;--Admission Date
. ;
. I (VAFSTR[",44,") D
. . I ($P(CURRENT(13,1),"^",1)'="") S $P(RESULT,HLFS,45)=$$HLDATE^HLFNC($P(CURRENT(13,1),"^",1),"TS")
. . E S $P(RESULT,HLFS,45)=HLQ
. ;
. ;
. ;--Discharge Date
. ;
. I (VAFSTR[",45,") D
. . I ($P(CURRENT(17,1),"^",1)'="") S $P(RESULT,HLFS,46)=$$HLDATE^HLFNC($P(CURRENT(17,1),"^",1),"TS")
. . E S $P(RESULT,HLFS,46)=HLQ
;
Q:$$TEST(7,RESULT,HLFS,VAFCOMP) RESULT
Q RESULT
DGBUILD(DGPMP,VAFSTR) ;
;
;Required Variables: DGPMP = 0 node of patient movement
; VAFSTR = HL7 fields requested e.g.
; ",3,7,10"
;
;This entry point builds an HL7 segment from data supplied
;from the 0 node of the Patient movement file in the required
;variable DGPMP. It is an internal PIMS call used to build
;a PV1 segment when the record has already been deleted.
;
;The call returns a fully encoded PV1 segment or a partially encoded
;PV1 segment containing only set id and patient class
;
N WARD,BED,ROOM,ATTNDPTR,ATTNDING,SPECPTR,SPECALTY,TRANSACT
N ADMPTR,ADMSSN,VAFCOMP,RESULT
;Check to have string follow correct format (",#,#,...,#,") DG*823
I $E(VAFSTR,1)'="," S VAFSTR=","_VAFSTR
I $E(VAFSTR,$L(VAFSTR))'="," S VAFSTR=VAFSTR_","
S RESULT="PV1"_HLFS_1_HLFS_"I" ;Inpatient
I $G(DGPMP)="" Q RESULT
S TRANSACT=$P(DGPMP,"^",2),VAFCOMP=$E(HLECH,1)
I TRANSACT=1 S VAFDIAG=$P(DGPMP,"^",10)
E S ADMPTR=$P(DGPMP,"^",14),ADMSSN=$G(^DGPM(ADMPTR,0)),VAFDIAG=$P(ADMSSN,"^",10)
;
;--Ward, Room, Bed
;
;Make sure all IF statements carry same logic (I VAFSTR[",#,") DG*823
I VAFSTR[",3," D
. N WARD,ROOM,BED
. ;
. ;--Check node 2 to see if it's a discharge movement
. ;
. ;
. I TRANSACT=3 D
. . S $P(RESULT,HLFS,4)=HLQ_VAFCOMP_HLQ_VAFCOMP_HLQ
. . ;
. . ;--All non discharge events are handled the same
. . ;
. I TRANSACT'=3 D
. . N WARDPTR,ROOMPTR,ROOM,WARD,BED
. . S WARDPTR=$P(DGPMP,"^",6)
. . S ROOMPTR=$P(DGPMP,"^",7)
. . I $G(WARDPTR)'="" S WARD=$P(^DIC(42,WARDPTR,0),"^",1)
. . I $G(ROOMPTR)'="" D
. . . S ROOM=$P(^DG(405.4,ROOMPTR,0),"^",1)
. . . S BED=$P(ROOM,"-",2)
. . . S ROOM=$P(ROOM,"-",1)
. . S $P(RESULT,HLFS,4)=$$HLQ^VAFHUTL($G(WARD))_VAFCOMP_$$HLQ^VAFHUTL($G(ROOM))_VAFCOMP_$$HLQ^VAFHUTL($G(BED))
. ;
. ;--Attending Physician
. ;
I VAFSTR[",7," D
. N ATTNDPTR,ATTNDING
. S ATTNDPTR=$P(DGPMP,"^",19)
. I $G(ATTNDPTR)'="" D
. . N DGNAME S DGNAME("FILE")=200,DGNAME("IENS")=ATTNDPTR,DGNAME("FIELD")=.01
. . S ATTNDING=$$HLNAME^XLFNAME(.DGNAME,"S",$E($G(HLECH)))
. S $P(RESULT,HLFS,8)=$$HLQ^VAFHUTL($G(ATTNDPTR))_VAFCOMP_$$HLQ^VAFHUTL($G(ATTNDING))
. ;
. ;--Treating Specialty
. ;
I VAFSTR[",10," D
. N SPECPTR,SPECALTY
. S SPECPTR=$P(DGPMP,"^",9)
. I $G(SPECPTR)'="" S SPECALTY=$P($G(^DIC(45.7,SPECPTR,0)),"^",2)
. S $P(RESULT,HLFS,11)=$$HLQ^VAFHUTL($G(SPECALTY))
;
;-- Patient Type
I VAFSTR[",18," D
. I +$G(^DPT(DFN,"TYPE")) DO
. . S $P(RESULT,HLFS,19)=$P($G(^DG(391,+^("TYPE"),0)),"^",1)
. E S $P(RESULT,HLFS,19)=HLQ
;
;--Physical Treating Specialty - Ward Location
;
I VAFSTR[",21," D
. N VAWARD,VAPHYTS
. ; get ward location pointer
. S VAWARD=$P($G(DGPMP),"^",6) Q:VAWARD=""
. ; get ward treating specialty
. S VAPHYTS=$P($G(^DIC(42,VAWARD,0)),"^",12)
. S $P(RESULT,HLFS,22)=$S(VAPHYTS]"":VAPHYTS,1:HLQ)
. Q
;
;--Facility and Suffix
;
N VAWARD,VAMEDCTR,VAFACSUF
I VAFSTR[",39," D
. ; get ward location pointer, med center div pointer
. S $P(RESULT,HLFS,40)=HLQ
. S VAWARD=$P($G(DGPMP),"^",6) Q:VAWARD=""
. S VAMEDCTR=$P($G(^DIC(42,VAWARD,0)),"^",11) Q:VAMEDCTR=""
. ; call below returns: inst pointer^inst name^station number w/suffix
. S VAFACSUF=$$SITE^VASITE($P(DGPMP,"^",1),VAMEDCTR)
. S VAFACSUF=$P(VAFACSUF,"^",3)
. ; move data into the PV1 segment
. S $P(RESULT,HLFS,40)=$S(VAFACSUF]"":VAFACSUF,1:HLQ)
;
;Discharge Disposition
;
I VAFSTR[",36," D ;If Discharge Disposition requested
. N DGDTYP
. S DGDTYP=$P($G(DGPMP),"^",18) ;Discharge type pointer in movement file
. S $P(RESULT,HLFS,37)=DGDTYP ;store in variable
;
;--Admission Date
;
I (VAFSTR[",44,") D
. I $P(DGPMP,"^",1)="" S $P(RESULT,HLFS,45)=HLQ
. E S $P(RESULT,HLFS,45)=$$HLDATE^HLFNC($P(DGPMP,"^",1),"TS")
;
Q:$$TEST(8,RESULT,HLFS,VAFCOMP) RESULT
Q RESULT
TEST(COUNTER,STRING,FIELDSEP,COMPNENT) ;
N CHAR,LENGTH
S LENGTH=$L(STRING)
NEXT ;
I COUNTER>LENGTH Q 0
S CHAR=$E(STRING,COUNTER,COUNTER)
I $G(CHAR)=FIELDSEP!($G(CHAR)=COMPNENT) S COUNTER=COUNTER+1 G NEXT
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFHAPV1 10067 printed Apr 09, 2024@21:40:05 Page 2
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
+2 ;
+3 ;The DGBUILD entry point is call used internally by MAS software
+4 ;to build a PV1 Segment for deleted Admissions. The DGPMP
+5 ;variable, available from the DGPM Event Driver at the time of
+6 ;the deletion, makes it possible to construct a partial PV1 segment
+7 ;for the deleted record.
+8 ;
+9 ;06/29/00 ACS - Added sequence 21 (physical treating specialty - ward
+10 ;location) and sequence 39 (facility + suffix).
+11 ;
EN(DFN,VAFHDT,VAFSTR,IEN,ALTVISID,SETID,VAFDIAG) ;
+1 ;
+2 ;This Entry Point builds the HL7 PV1 segment for inpatients.
+3 ;
+4 ;DFN, VAFHDT, & VAFSTR are the required variables.
+5 ;
+6 ; DFN = IEN of Patient File
+7 ; VAFHDT = Date/Time of Patient Movement
+8 ; VAFSTR = HL7 Fields Requested e.g. ",3,7,10"
+9 ;
+10 ;IEN, ALTVISID, SETID are the optional variables
+11 ;
+12 ;The optional variable IEN is used for Discharge movements
+13 ;because if only Date/Time is passed for a Discharge movement
+14 ;no useful information is returned by VADPT.
+15 ;
+16 ;The optional ALTVISID variable is used to pass in a "Alternate.
+17 ;Visit ID" this is a unique number that
+18 ;identifies this Admission or episode of care
+19 ;
+20 ;The optional variable SETID can be used to differentiate
+21 ;different sets of data, in messages that may contain multiple
+22 ;events or messages.
+23 ;
+24 ;VAFDIAG, is a passed as a dotted variable. The inpatient diagnosis
+25 ;is then returned in this variable.
+26 ;
+27 NEW VAFCOMP,RESULT,VAROOT,VA200
+28 NEW CURRENT
+29 ;Make sure the VAFSTR string is correctly formatted (",#,#,...,#,") DG*823
+30 IF $EXTRACT(VAFSTR,1)'=","
SET VAFSTR=","_VAFSTR
+31 IF $EXTRACT(VAFSTR,$LENGTH(VAFSTR))'=","
SET VAFSTR=VAFSTR_","
+32 ;
+33 DO KVAR^VADPT
+34 SET VAFCOMP=$EXTRACT(HLECH,1)
+35 SET VAROOT="CURRENT"
SET VAIP("D")=VAFHDT
SET VA200=1
+36 IF ($GET(IEN)'="")
SET VAIP("E")=IEN
+37 DO IN5^VADPT
+38 SET RESULT=$$BUILD()
+39 IF $GET(ALTVISID)'=""
SET $PIECE(RESULT,HLFS,51)=ALTVISID
+40 IF $GET(SETID)'=""
SET $PIECE(RESULT,HLFS,2)=SETID
+41 IF $GET(SETID)=""
SET $PIECE(RESULT,HLFS,2)=1
+42 ;
EXIT ;
+1 QUIT $GET(RESULT)
+2 ;
BUILD() ;Build the PV1 Segment
+1 ;
+2 ;Required Variables: Array "CURRENT" containing the results
+3 ; of a call to VADPT
+4 ;
+5 ;This entry point is called to build the HL7 PV1 segment from
+6 ;data returned by VADPT
+7 ;
+8 ;It returns a fully encoded HL7 segment, or a partially encoded HL7 segment containing patient class only
+9 ;
+10 NEW RESULT,SUBS
+11 SET RESULT="PV1"_HLFS_HLFS_"I"
+12 IF $GET(CURRENT(1))=""
QUIT RESULT
+13 IF $GET(CURRENT(1))'=""
Begin DoDot:1
+14 SET VAFDIAG=CURRENT(9)
+15 ;
+16 ;--Ward, Room, Bed
+17 ;
+18 ;Format all If statements to be the same (I VAFSTR[",#,") DG*823
+19 IF VAFSTR[",3,"
Begin DoDot:2
+20 NEW WARD,ROOM,BED
+21 SET WARD=$$HLQ^VAFHUTL($PIECE(CURRENT(5),"^",2))
+22 SET ROOM=$$HLQ^VAFHUTL($PIECE($PIECE(CURRENT(6),"^",2),"-",1))
+23 SET BED=$$HLQ^VAFHUTL($PIECE($PIECE(CURRENT(6),"^",2),"-",2))
+24 SET $PIECE(RESULT,HLFS,4)=$GET(WARD)_VAFCOMP_$GET(ROOM)_VAFCOMP_$GET(BED)
End DoDot:2
+25 ;
+26 ;--Attending Physician
+27 ;
+28 IF VAFSTR[",7,"
Begin DoDot:2
+29 NEW ATTNDPTR,ATTNDING
+30 SET ATTNDPTR=$PIECE(CURRENT(18),"^",1)
+31 ;S:ATTNDPTR'="" ATTNDING=$$HLNAME^HLFNC($P(CURRENT(18),"^",2))
+32 IF $GET(ATTNDPTR)'=""
Begin DoDot:3
+33 NEW DGNAME
SET DGNAME("FILE")=200
SET DGNAME("IENS")=ATTNDPTR
SET DGNAME("FIELD")=.01
+34 SET ATTNDING=$$HLNAME^XLFNAME(.DGNAME,"S",$EXTRACT($GET(HLECH)))
End DoDot:3
+35 SET $PIECE(RESULT,HLFS,8)=$$HLQ^VAFHUTL($GET(ATTNDPTR))_VAFCOMP_$$HLQ^VAFHUTL($GET(ATTNDING))
End DoDot:2
+36 ;
+37 ;--Treating Specialty
+38 ;
+39 IF VAFSTR[",10,"
Begin DoDot:2
+40 NEW SPECPTR,SPECALTY
+41 SET SPECPTR=$PIECE(CURRENT(8),"^",1)
+42 if $GET(SPECPTR)'=""
SET SPECALTY=$PIECE($GET(^DIC(45.7,SPECPTR,0)),"^",2)
+43 SET $PIECE(RESULT,HLFS,11)=$$HLQ^VAFHUTL($GET(SPECALTY))
End DoDot:2
+44 ;
+45 ;--Previous Patient Location
+46 IF VAFSTR[",6,"
Begin DoDot:2
+47 NEW WARD,ROOM,BED,ROOMPTR,ROOMBED,MOVEMENT
+48 SET WARD=$$HLQ^VAFHUTL($PIECE(CURRENT(15,4),"^",2))
+49 SET MOVEMENT=$GET(CURRENT(15))
+50 IF MOVEMENT
Begin DoDot:3
+51 SET ROOMPTR=$PIECE(^DGPM(MOVEMENT,0),"^",7)
+52 IF ROOMPTR
Begin DoDot:4
+53 SET ROOMBED=$PIECE(^DG(405.4,ROOMPTR,0),"^",1)
+54 IF (ROOMBED'="")
Begin DoDot:5
+55 SET ROOM=$PIECE(ROOMBED,"-",1)
+56 SET BED=$PIECE(ROOMBED,"-",2)
End DoDot:5
End DoDot:4
End DoDot:3
+57 SET $PIECE(RESULT,HLFS,7)=$$HLQ^VAFHUTL($GET(WARD))_VAFCOMP_$$HLQ^VAFHUTL($GET(ROOM))_VAFCOMP_$$HLQ^VAFHUTL($GET(BED))
End DoDot:2
+58 ;
+59 ;-- Patient Type
+60 IF VAFSTR[",18,"
Begin DoDot:2
+61 IF +$GET(^DPT(DFN,"TYPE"))
Begin DoDot:3
+62 SET $PIECE(RESULT,HLFS,19)=$PIECE($GET(^DG(391,+^("TYPE"),0)),"^",1)
End DoDot:3
+63 IF '$TEST
SET $PIECE(RESULT,HLFS,19)=HLQ
End DoDot:2
+64 ;
+65 ;--Physical Treating Specialty - Ward Location
+66 ;
+67 IF VAFSTR[",21,"
Begin DoDot:2
+68 NEW VAWARD,VAPHYTS
+69 ; get ward location pointer
+70 SET VAWARD=$PIECE($GET(CURRENT(5)),"^",1)
if VAWARD=""
QUIT
+71 ; get ward treating specialty pointer
+72 SET VAPHYTS=$PIECE($GET(^DIC(42,VAWARD,0)),"^",12)
+73 SET $PIECE(RESULT,HLFS,22)=$SELECT(VAPHYTS]"":VAPHYTS,1:HLQ)
+74 QUIT
End DoDot:2
+75 ;
+76 ;--Facility and Suffix
+77 IF VAFSTR[",39,"
Begin DoDot:2
+78 NEW VAFIEN,VAWARD,VAMEDCTR,VAFACSUF
+79 ; get patient movement IEN, ward loc ptr, med center div ptr
+80 SET VAFIEN=$GET(CURRENT(1))
+81 SET VAWARD=$PIECE($GET(^DGPM(VAFIEN,0)),"^",6)
if VAWARD=""
QUIT
+82 SET VAMEDCTR=$PIECE($GET(^DIC(42,VAWARD,0)),"^",11)
if VAMEDCTR=""
QUIT
+83 ; call below returns: inst pointer^inst name^station number w/suffix
+84 SET VAFACSUF=$$SITE^VASITE($GET(CURRENT(3)),VAMEDCTR)
+85 SET VAFACSUF=$PIECE(VAFACSUF,"^",3)
+86 ; move data into the PV1 segment
+87 SET $PIECE(RESULT,HLFS,40)=$SELECT(VAFACSUF]"":VAFACSUF,1:HLQ)
End DoDot:2
+88 ;
+89 ;Discharge Disposition
+90 ;If Discharge Disposition requested
IF VAFSTR[",36,"
Begin DoDot:2
+91 NEW DGDTYP
+92 SET DGDTYP=$PIECE(CURRENT(17,3),"^")
SET $PIECE(RESULT,HLFS,37)=DGDTYP
End DoDot:2
+93 ;
+94 ;--Admission Date
+95 ;
+96 IF (VAFSTR[",44,")
Begin DoDot:2
+97 IF ($PIECE(CURRENT(13,1),"^",1)'="")
SET $PIECE(RESULT,HLFS,45)=$$HLDATE^HLFNC($PIECE(CURRENT(13,1),"^",1),"TS")
+98 IF '$TEST
SET $PIECE(RESULT,HLFS,45)=HLQ
End DoDot:2
+99 ;
+100 ;
+101 ;--Discharge Date
+102 ;
+103 IF (VAFSTR[",45,")
Begin DoDot:2
+104 IF ($PIECE(CURRENT(17,1),"^",1)'="")
SET $PIECE(RESULT,HLFS,46)=$$HLDATE^HLFNC($PIECE(CURRENT(17,1),"^",1),"TS")
+105 IF '$TEST
SET $PIECE(RESULT,HLFS,46)=HLQ
End DoDot:2
End DoDot:1
+106 ;
+107 if $$TEST(7,RESULT,HLFS,VAFCOMP)
QUIT RESULT
+108 QUIT RESULT
DGBUILD(DGPMP,VAFSTR) ;
+1 ;
+2 ;Required Variables: DGPMP = 0 node of patient movement
+3 ; VAFSTR = HL7 fields requested e.g.
+4 ; ",3,7,10"
+5 ;
+6 ;This entry point builds an HL7 segment from data supplied
+7 ;from the 0 node of the Patient movement file in the required
+8 ;variable DGPMP. It is an internal PIMS call used to build
+9 ;a PV1 segment when the record has already been deleted.
+10 ;
+11 ;The call returns a fully encoded PV1 segment or a partially encoded
+12 ;PV1 segment containing only set id and patient class
+13 ;
+14 NEW WARD,BED,ROOM,ATTNDPTR,ATTNDING,SPECPTR,SPECALTY,TRANSACT
+15 NEW ADMPTR,ADMSSN,VAFCOMP,RESULT
+16 ;Check to have string follow correct format (",#,#,...,#,") DG*823
+17 IF $EXTRACT(VAFSTR,1)'=","
SET VAFSTR=","_VAFSTR
+18 IF $EXTRACT(VAFSTR,$LENGTH(VAFSTR))'=","
SET VAFSTR=VAFSTR_","
+19 ;Inpatient
SET RESULT="PV1"_HLFS_1_HLFS_"I"
+20 IF $GET(DGPMP)=""
QUIT RESULT
+21 SET TRANSACT=$PIECE(DGPMP,"^",2)
SET VAFCOMP=$EXTRACT(HLECH,1)
+22 IF TRANSACT=1
SET VAFDIAG=$PIECE(DGPMP,"^",10)
+23 IF '$TEST
SET ADMPTR=$PIECE(DGPMP,"^",14)
SET ADMSSN=$GET(^DGPM(ADMPTR,0))
SET VAFDIAG=$PIECE(ADMSSN,"^",10)
+24 ;
+25 ;--Ward, Room, Bed
+26 ;
+27 ;Make sure all IF statements carry same logic (I VAFSTR[",#,") DG*823
+28 IF VAFSTR[",3,"
Begin DoDot:1
+29 NEW WARD,ROOM,BED
+30 ;
+31 ;--Check node 2 to see if it's a discharge movement
+32 ;
+33 ;
+34 IF TRANSACT=3
Begin DoDot:2
+35 SET $PIECE(RESULT,HLFS,4)=HLQ_VAFCOMP_HLQ_VAFCOMP_HLQ
+36 ;
+37 ;--All non discharge events are handled the same
+38 ;
End DoDot:2
+39 IF TRANSACT'=3
Begin DoDot:2
+40 NEW WARDPTR,ROOMPTR,ROOM,WARD,BED
+41 SET WARDPTR=$PIECE(DGPMP,"^",6)
+42 SET ROOMPTR=$PIECE(DGPMP,"^",7)
+43 IF $GET(WARDPTR)'=""
SET WARD=$PIECE(^DIC(42,WARDPTR,0),"^",1)
+44 IF $GET(ROOMPTR)'=""
Begin DoDot:3
+45 SET ROOM=$PIECE(^DG(405.4,ROOMPTR,0),"^",1)
+46 SET BED=$PIECE(ROOM,"-",2)
+47 SET ROOM=$PIECE(ROOM,"-",1)
End DoDot:3
+48 SET $PIECE(RESULT,HLFS,4)=$$HLQ^VAFHUTL($GET(WARD))_VAFCOMP_$$HLQ^VAFHUTL($GET(ROOM))_VAFCOMP_$$HLQ^VAFHUTL($GET(BED))
End DoDot:2
+49 ;
+50 ;--Attending Physician
+51 ;
End DoDot:1
+52 IF VAFSTR[",7,"
Begin DoDot:1
+53 NEW ATTNDPTR,ATTNDING
+54 SET ATTNDPTR=$PIECE(DGPMP,"^",19)
+55 IF $GET(ATTNDPTR)'=""
Begin DoDot:2
+56 NEW DGNAME
SET DGNAME("FILE")=200
SET DGNAME("IENS")=ATTNDPTR
SET DGNAME("FIELD")=.01
+57 SET ATTNDING=$$HLNAME^XLFNAME(.DGNAME,"S",$EXTRACT($GET(HLECH)))
End DoDot:2
+58 SET $PIECE(RESULT,HLFS,8)=$$HLQ^VAFHUTL($GET(ATTNDPTR))_VAFCOMP_$$HLQ^VAFHUTL($GET(ATTNDING))
+59 ;
+60 ;--Treating Specialty
+61 ;
End DoDot:1
+62 IF VAFSTR[",10,"
Begin DoDot:1
+63 NEW SPECPTR,SPECALTY
+64 SET SPECPTR=$PIECE(DGPMP,"^",9)
+65 IF $GET(SPECPTR)'=""
SET SPECALTY=$PIECE($GET(^DIC(45.7,SPECPTR,0)),"^",2)
+66 SET $PIECE(RESULT,HLFS,11)=$$HLQ^VAFHUTL($GET(SPECALTY))
End DoDot:1
+67 ;
+68 ;-- Patient Type
+69 IF VAFSTR[",18,"
Begin DoDot:1
+70 IF +$GET(^DPT(DFN,"TYPE"))
Begin DoDot:2
+71 SET $PIECE(RESULT,HLFS,19)=$PIECE($GET(^DG(391,+^("TYPE"),0)),"^",1)
End DoDot:2
+72 IF '$TEST
SET $PIECE(RESULT,HLFS,19)=HLQ
End DoDot:1
+73 ;
+74 ;--Physical Treating Specialty - Ward Location
+75 ;
+76 IF VAFSTR[",21,"
Begin DoDot:1
+77 NEW VAWARD,VAPHYTS
+78 ; get ward location pointer
+79 SET VAWARD=$PIECE($GET(DGPMP),"^",6)
if VAWARD=""
QUIT
+80 ; get ward treating specialty
+81 SET VAPHYTS=$PIECE($GET(^DIC(42,VAWARD,0)),"^",12)
+82 SET $PIECE(RESULT,HLFS,22)=$SELECT(VAPHYTS]"":VAPHYTS,1:HLQ)
+83 QUIT
End DoDot:1
+84 ;
+85 ;--Facility and Suffix
+86 ;
+87 NEW VAWARD,VAMEDCTR,VAFACSUF
+88 IF VAFSTR[",39,"
Begin DoDot:1
+89 ; get ward location pointer, med center div pointer
+90 SET $PIECE(RESULT,HLFS,40)=HLQ
+91 SET VAWARD=$PIECE($GET(DGPMP),"^",6)
if VAWARD=""
QUIT
+92 SET VAMEDCTR=$PIECE($GET(^DIC(42,VAWARD,0)),"^",11)
if VAMEDCTR=""
QUIT
+93 ; call below returns: inst pointer^inst name^station number w/suffix
+94 SET VAFACSUF=$$SITE^VASITE($PIECE(DGPMP,"^",1),VAMEDCTR)
+95 SET VAFACSUF=$PIECE(VAFACSUF,"^",3)
+96 ; move data into the PV1 segment
+97 SET $PIECE(RESULT,HLFS,40)=$SELECT(VAFACSUF]"":VAFACSUF,1:HLQ)
End DoDot:1
+98 ;
+99 ;Discharge Disposition
+100 ;
+101 ;If Discharge Disposition requested
IF VAFSTR[",36,"
Begin DoDot:1
+102 NEW DGDTYP
+103 ;Discharge type pointer in movement file
SET DGDTYP=$PIECE($GET(DGPMP),"^",18)
+104 ;store in variable
SET $PIECE(RESULT,HLFS,37)=DGDTYP
End DoDot:1
+105 ;
+106 ;--Admission Date
+107 ;
+108 IF (VAFSTR[",44,")
Begin DoDot:1
+109 IF $PIECE(DGPMP,"^",1)=""
SET $PIECE(RESULT,HLFS,45)=HLQ
+110 IF '$TEST
SET $PIECE(RESULT,HLFS,45)=$$HLDATE^HLFNC($PIECE(DGPMP,"^",1),"TS")
End DoDot:1
+111 ;
+112 if $$TEST(8,RESULT,HLFS,VAFCOMP)
QUIT RESULT
+113 QUIT RESULT
TEST(COUNTER,STRING,FIELDSEP,COMPNENT) ;
+1 NEW CHAR,LENGTH
+2 SET LENGTH=$LENGTH(STRING)
NEXT ;
+1 IF COUNTER>LENGTH
QUIT 0
+2 SET CHAR=$EXTRACT(STRING,COUNTER,COUNTER)
+3 IF $GET(CHAR)=FIELDSEP!($GET(CHAR)=COMPNENT)
SET COUNTER=COUNTER+1
GOTO NEXT
+4 QUIT 1
