MDCPV1.m

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 ---MDCPV1   2280     printed  Apr 09, 2024@20:48:56                                                                                                                                                                                                      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)