MDCSPV1 ;HINES OIFO/DP/BJ - Build Segment PV1 Routine;17 Aug 2007
;;1.0;CLINICAL PROCEDURES;**16,23**;Apr 01, 2004;Build 281
;Per VHA Directive 2004-038, this routine should not be modified.
;
; - This sub-routine is the Segment Builder proper for the HL7 Patient
; Visit 1 (PV1) Segment.
; This routine uses the following IAs:
; #10039 - access ^DIC(42 Registration (supported)
;
Q
BUILD(VAFSTR,VAFNUM,PMOOV,PSEG,TRUBL) ;
;
; - INPUT
; VAFSTR = field selection string; field number in string, field into segment
; VAFNUM = segment number; pass "0001", else routine sets.
; PMOOV = CP_MOVEMENT_AUDIT file record !!Passed by reference!!
; PSEG = segment buffer. !!Passed by reference!!
; TRUBL = error return string. !! Passed by reference !!
;
;
; - PREDEFINED LOCALS
; HLECH = Subfield seperation character defined in MDCPV1
;
;
; - OUTPUT
; If no errors detected, PSEG contains the message segment. If the character count
; exceeds HLMAXLEN, SUBScripted extension segments are allocated, one for each time HLMAXLEN
; is exceeded. Below is a possible example.
; PSEG = up to HLMAXLEN characters of segment
; PSEG(1) = up to HLMAXLEN characters of segment
; PSEG(2) = remaining characters of segment
; If an error is detected, TRUBL contains an error message string. PSEG is killed.
;
; Fields are not broken across segment boundaries. If the number of characters in a field
; plus the separator character (HLFS) that precedes the field will push a segment's character
; count beyond HLMAXLEN, a new overflow segment is established. The field and its
; preceding separator are placed there.
;
;
N PV1,FLD,RUMBE,PRAW,WRDLO
;
;
; - The segment is required. Right now, our data comes from just an entry in the
; 704.005 file. If it is absent or empty,
; exit now with no error. There is one required field. If any data present in PV1 node,
; the required field (in PV1) must be present. Otherwise error. Checked for below.
I $TR($G(PMOOV(0)),U)="" Q
S PV1=PMOOV(0)
;
;
; - segment number
I VAFNUM="0001" S PRAW(1)=VAFNUM
I VAFNUM'="0001" S PRAW(1)="0001"
;
;
; - patient class. I for Inpatient, O for Outpatient
; but all is Inpatient
;
I (VAFSTR[",2,") S PRAW(2)="I"
;
; - Assigned Patient Location/Point of Care. There are 3 components: Point of Care,
; which is the Medical Center Division ID; the Room, which is the Ward Location
; ID; and Bed, which is the ROOM-BED ID. Since the Patient Location field is Required, its
; two Required components, Point of Care and Room, must both be present.
S (FLD,WRDLO,RUMBE)=""
I (VAFSTR[",3,") D
.; - look for characters to escape
.I ($TR(FLD,HL7RC)'=FLD) S FLD=$$ESC^MDCUTL(FLD)
.; employ the pointer to the Ward Location file
.I ($P(PV1,U,4)'="") S WRDLO=$P($G(^DIC(42,($P(PV1,U,4)),0)),U)
.; - look for characters to escape
.I ($TR(WRDLO,HL7RC)'=WRDLO) S WRDLO=$$ESC^MDCUTL(WRDLO)
.; - employ the pointer to the ROOM-BED file
.I ($P(PV1,U,5)'="") S MDF4054=405.4,RUMBE=$$GET1^DIQ(MDF4054,($P(PV1,U,5))_",","NAME") K MDF4054
.; - there are 3 parts: Room ID, Bed ID, and (sometimes) Building ID
.; - get room and bed IDs, dropping building ID if present
.S RUMBE=$P(RUMBE,"-",1,2)
.; - check for characters to escape
.I ($TR(RUMBE,HL7RC)'=RUMBE) S RUMBE=$$ESC^MDCUTL(RUMBE)
.; Room and bed are supposed to be in different fields.
.; Note: According to our conformance profile, subfield separators are always '^'. Ideally, we'll
.; want to change this to something out of the environment, but I'm not sure what the original
.; developers did with the variable that was supposed to hold the subfield separator.
.S RUMBE=$TR(RUMBE,"-","^")
.; - assemble field from components; no separators for absent trailing components
.; blj 17 Mar 2011: The wrong delimiter was being used below
.;I RUMBE'="" S WRDLO=WRDLO_HLRP_RUMBE
.I RUMBE'="" S WRDLO=WRDLO_HLCM_RUMBE
.I WRDLO'="" S FLD=WRDLO
;
S PRAW(3)=FLD
;
; - Attending Doc field. approximately XCN format. not required, but
; pointer should be good if present and can be checked for later.
;I ($P(PV1,U,19)'=""),(VAFSTR[",7,") S PRAW(7)=$$DOCINF^MDCPV1($P(PV1,U,19))
;
D MAKESEG^MDCUTL(.PRAW,.PSEG,0,"PV1")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDCSPV1 4483 printed Apr 09, 2024@20:48:49 Page 2
MDCSPV1 ;HINES OIFO/DP/BJ - Build Segment PV1 Routine;17 Aug 2007
+1 ;;1.0;CLINICAL PROCEDURES;**16,23**;Apr 01, 2004;Build 281
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; - This sub-routine is the Segment Builder proper for the HL7 Patient
+5 ; Visit 1 (PV1) Segment.
+6 ; This routine uses the following IAs:
+7 ; #10039 - access ^DIC(42 Registration (supported)
+8 ;
+9 QUIT
BUILD(VAFSTR,VAFNUM,PMOOV,PSEG,TRUBL) ;
+1 ;
+2 ; - INPUT
+3 ; VAFSTR = field selection string; field number in string, field into segment
+4 ; VAFNUM = segment number; pass "0001", else routine sets.
+5 ; PMOOV = CP_MOVEMENT_AUDIT file record !!Passed by reference!!
+6 ; PSEG = segment buffer. !!Passed by reference!!
+7 ; TRUBL = error return string. !! Passed by reference !!
+8 ;
+9 ;
+10 ; - PREDEFINED LOCALS
+11 ; HLECH = Subfield seperation character defined in MDCPV1
+12 ;
+13 ;
+14 ; - OUTPUT
+15 ; If no errors detected, PSEG contains the message segment. If the character count
+16 ; exceeds HLMAXLEN, SUBScripted extension segments are allocated, one for each time HLMAXLEN
+17 ; is exceeded. Below is a possible example.
+18 ; PSEG = up to HLMAXLEN characters of segment
+19 ; PSEG(1) = up to HLMAXLEN characters of segment
+20 ; PSEG(2) = remaining characters of segment
+21 ; If an error is detected, TRUBL contains an error message string. PSEG is killed.
+22 ;
+23 ; Fields are not broken across segment boundaries. If the number of characters in a field
+24 ; plus the separator character (HLFS) that precedes the field will push a segment's character
+25 ; count beyond HLMAXLEN, a new overflow segment is established. The field and its
+26 ; preceding separator are placed there.
+27 ;
+28 ;
+29 NEW PV1,FLD,RUMBE,PRAW,WRDLO
+30 ;
+31 ;
+32 ; - The segment is required. Right now, our data comes from just an entry in the
+33 ; 704.005 file. If it is absent or empty,
+34 ; exit now with no error. There is one required field. If any data present in PV1 node,
+35 ; the required field (in PV1) must be present. Otherwise error. Checked for below.
+36 IF $TRANSLATE($GET(PMOOV(0)),U)=""
QUIT
+37 SET PV1=PMOOV(0)
+38 ;
+39 ;
+40 ; - segment number
+41 IF VAFNUM="0001"
SET PRAW(1)=VAFNUM
+42 IF VAFNUM'="0001"
SET PRAW(1)="0001"
+43 ;
+44 ;
+45 ; - patient class. I for Inpatient, O for Outpatient
+46 ; but all is Inpatient
+47 ;
+48 IF (VAFSTR[",2,")
SET PRAW(2)="I"
+49 ;
+50 ; - Assigned Patient Location/Point of Care. There are 3 components: Point of Care,
+51 ; which is the Medical Center Division ID; the Room, which is the Ward Location
+52 ; ID; and Bed, which is the ROOM-BED ID. Since the Patient Location field is Required, its
+53 ; two Required components, Point of Care and Room, must both be present.
+54 SET (FLD,WRDLO,RUMBE)=""
+55 IF (VAFSTR[",3,")
Begin DoDot:1
+56 ; - look for characters to escape
+57 IF ($TRANSLATE(FLD,HL7RC)'=FLD)
SET FLD=$$ESC^MDCUTL(FLD)
+58 ; employ the pointer to the Ward Location file
+59 IF ($PIECE(PV1,U,4)'="")
SET WRDLO=$PIECE($GET(^DIC(42,($PIECE(PV1,U,4)),0)),U)
+60 ; - look for characters to escape
+61 IF ($TRANSLATE(WRDLO,HL7RC)'=WRDLO)
SET WRDLO=$$ESC^MDCUTL(WRDLO)
+62 ; - employ the pointer to the ROOM-BED file
+63 IF ($PIECE(PV1,U,5)'="")
SET MDF4054=405.4
SET RUMBE=$$GET1^DIQ(MDF4054,($PIECE(PV1,U,5))_",","NAME")
KILL MDF4054
+64 ; - there are 3 parts: Room ID, Bed ID, and (sometimes) Building ID
+65 ; - get room and bed IDs, dropping building ID if present
+66 SET RUMBE=$PIECE(RUMBE,"-",1,2)
+67 ; - check for characters to escape
+68 IF ($TRANSLATE(RUMBE,HL7RC)'=RUMBE)
SET RUMBE=$$ESC^MDCUTL(RUMBE)
+69 ; Room and bed are supposed to be in different fields.
+70 ; Note: According to our conformance profile, subfield separators are always '^'. Ideally, we'll
+71 ; want to change this to something out of the environment, but I'm not sure what the original
+72 ; developers did with the variable that was supposed to hold the subfield separator.
+73 SET RUMBE=$TRANSLATE(RUMBE,"-","^")
+74 ; - assemble field from components; no separators for absent trailing components
+75 ; blj 17 Mar 2011: The wrong delimiter was being used below
+76 ;I RUMBE'="" S WRDLO=WRDLO_HLRP_RUMBE
+77 IF RUMBE'=""
SET WRDLO=WRDLO_HLCM_RUMBE
+78 IF WRDLO'=""
SET FLD=WRDLO
End DoDot:1
+79 ;
+80 SET PRAW(3)=FLD
+81 ;
+82 ; - Attending Doc field. approximately XCN format. not required, but
+83 ; pointer should be good if present and can be checked for later.
+84 ;I ($P(PV1,U,19)'=""),(VAFSTR[",7,") S PRAW(7)=$$DOCINF^MDCPV1($P(PV1,U,19))
+85 ;
+86 DO MAKESEG^MDCUTL(.PRAW,.PSEG,0,"PV1")
+87 QUIT
+88 ;
