- 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 Mar 13, 2025@20:47:14 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)
