- 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 Dec 13, 2024@03:02:44 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