MDCPV1 ;HINES OIFO/DP/BJ - PV1 Segment Routine;08 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 routine uses the following Integration Agreements (IAs):
; #2050 - $$EZBLD^DIALOG() (supported)
;
; - The PV1 Segment Wrapper Sub-routine. This interfaces the creation of a PV1
; segment by the PV1 segment builder.
Q
EN(PATMVMT,PV1SEG,PV1RONG) ;
;
; PATMVMT = the 704.005 file entry for the HL7 message !! Pass by reference !!
; PV1SEG = root segment buffer where the PV1 information is to be stored
; !! Pass by reference !!
; PV1RONG = the string the error message string goes !! Pass by reference !!
;
N VAFSTR,CHUNX,HLECH,HLMAXLEN,HLCM,HLRP,HLSC,HLES,HLFS,HLQ,HL7RC,HLECH
S VAFSTR=",1,2,3,"
D MOREDLMS^MDCUTL
; - obtain PV1 information
; submit the field selection string and Segment number in addition to the
; parameters passed by the message builder
D BUILD^MDCSPV1(VAFSTR,"0001",.PATMVMT,.PV1SEG,.PV1RONG)
;
; - bail if no segment material
Q:$G(PV1SEG)=""
S CHUNX=($D(PV1SEG))-1
Q:(CHUNX=9)!(CHUNX=-1)
;
N APL,APLOC
S APL=3+1
S APLOC=$P(PV1SEG,HLFS,APL)
; Change the delimiters from HLRP to HLCM. Otherwise a message never gets built.
;I $P(APLOC,HLRP,1)="" S PV1RONG=$$PVERMSG^MDCPV1("PV1.3.1",MDCIEN,704.005) Q
;I $P(APLOC,HLRP,2)="" S PV1RONG=$$PVERMSG^MDCPV1("PV1.3.2",MDCIEN,704.005) Q
;Note: if this is an A08, then we're not gonna have an inpatient location and such like.
I $P(PATMVMT("0"),U,7)'="A08" D
.I $P(APLOC,HLCM,1)="" S PV1RONG=$$PVERMSG^MDCPV1("PV1.3.1",MDCIEN,704.005) Q
.I $P(APLOC,HLCM,2)="" S PV1RONG=$$PVERMSG^MDCPV1("PV1.3.2",MDCIEN,704.005) Q
;
Q
;
; here is an interface for the error message routine
PVERMSG(ELMT,RIEN,FILEN) ;
; - this function invokes error message creation.
; ELMT = the HL7 element ID, such as PV1.7.2
; RIEN = IEN of record lacking missing or containing missing element
; FILEN = File number of fileman file containing record
N PV1PRAMS
S PV1PRAMS(1)=ELMT,PV1PRAMS(2)=RIEN,PV1PRAMS(3)=FILEN
Q $$EZBLD^DIALOG(7040020.001,.PV1PRAMS)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDCPV1 2280 printed Sep 23, 2025@19:18:33 Page 2
MDCPV1 ;HINES OIFO/DP/BJ - PV1 Segment Routine;08 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 routine uses the following Integration Agreements (IAs):
+5 ; #2050 - $$EZBLD^DIALOG() (supported)
+6 ;
+7 ; - The PV1 Segment Wrapper Sub-routine. This interfaces the creation of a PV1
+8 ; segment by the PV1 segment builder.
+9 QUIT
EN(PATMVMT,PV1SEG,PV1RONG) ;
+1 ;
+2 ; PATMVMT = the 704.005 file entry for the HL7 message !! Pass by reference !!
+3 ; PV1SEG = root segment buffer where the PV1 information is to be stored
+4 ; !! Pass by reference !!
+5 ; PV1RONG = the string the error message string goes !! Pass by reference !!
+6 ;
+7 NEW VAFSTR,CHUNX,HLECH,HLMAXLEN,HLCM,HLRP,HLSC,HLES,HLFS,HLQ,HL7RC,HLECH
+8 SET VAFSTR=",1,2,3,"
+9 DO MOREDLMS^MDCUTL
+10 ; - obtain PV1 information
+11 ; submit the field selection string and Segment number in addition to the
+12 ; parameters passed by the message builder
+13 DO BUILD^MDCSPV1(VAFSTR,"0001",.PATMVMT,.PV1SEG,.PV1RONG)
+14 ;
+15 ; - bail if no segment material
+16 if $GET(PV1SEG)=""
QUIT
+17 SET CHUNX=($DATA(PV1SEG))-1
+18 if (CHUNX=9)!(CHUNX=-1)
QUIT
+19 ;
+20 NEW APL,APLOC
+21 SET APL=3+1
+22 SET APLOC=$PIECE(PV1SEG,HLFS,APL)
+23 ; Change the delimiters from HLRP to HLCM. Otherwise a message never gets built.
+24 ;I $P(APLOC,HLRP,1)="" S PV1RONG=$$PVERMSG^MDCPV1("PV1.3.1",MDCIEN,704.005) Q
+25 ;I $P(APLOC,HLRP,2)="" S PV1RONG=$$PVERMSG^MDCPV1("PV1.3.2",MDCIEN,704.005) Q
+26 ;Note: if this is an A08, then we're not gonna have an inpatient location and such like.
+27 IF $PIECE(PATMVMT("0"),U,7)'="A08"
Begin DoDot:1
+28 IF $PIECE(APLOC,HLCM,1)=""
SET PV1RONG=$$PVERMSG^MDCPV1("PV1.3.1",MDCIEN,704.005)
QUIT
+29 IF $PIECE(APLOC,HLCM,2)=""
SET PV1RONG=$$PVERMSG^MDCPV1("PV1.3.2",MDCIEN,704.005)
QUIT
End DoDot:1
+30 ;
+31 QUIT
+32 ;
+33 ; here is an interface for the error message routine
PVERMSG(ELMT,RIEN,FILEN) ;
+1 ; - this function invokes error message creation.
+2 ; ELMT = the HL7 element ID, such as PV1.7.2
+3 ; RIEN = IEN of record lacking missing or containing missing element
+4 ; FILEN = File number of fileman file containing record
+5 NEW PV1PRAMS
+6 SET PV1PRAMS(1)=ELMT
SET PV1PRAMS(2)=RIEN
SET PV1PRAMS(3)=FILEN
+7 QUIT $$EZBLD^DIALOG(7040020.001,.PV1PRAMS)
