PRCOEC3.m

PRCOEC3 ;WISC/DJM-IFCAP SEGMENTS HE,MI ;11/24/93  15:03

V ;;5.1;IFCAP;;Oct 20, 2000

 ;Per VHA Directive 10-93-142, this routine should not be modified.

HE(VAR1,VAR2) ;PO HEADER INFORMATION SEGMENT

 N A,A1,A12,DD,P,PHN,POD,X,Y

 S A=$G(^PRC(442,VAR1,0)),A1=$G(^PRC(442,VAR1,1)),A12=$G(^PRC(442,VAR1,12)) S:A12="" VAR2="ERROR" W:A12="" !,"NP12-No node 12 in file 442 for this P.O." Q:A12=""

 S X=$P(A1,U,15) S:X="" VAR2="ERROR" W:X="" !,"NPOD No purchase order date in file 442 for this P.O." Q:X=""

 S X=$P(A,U,10) S:X="" VAR2="ERROR" W:X="" !,"NDD No delivery date for this P.O. in file 442." Q:X=""  S P=$P(A1,U,10)

 S:P="" VAR2="ERROR" W:P="" !,"NPPM No purchasing agent entry in file 442 for this P.O." Q:P=""

 S PHN=$P($G(^VA(200,P,.13)),"^",5) I PHN="",'$G(PRCHPC) S VAR2="ERROR" W !,"NPHN No phone number node in the person file for this PPM."

 S PHN=$P(PHN,U) I PHN="",'$G(PRCHPC) S VAR2="ERROR" W !,"NPH No phone number for this PPM in the person file."

 Q

MI(VAR1,VAR2) ;MISCELLANEOUS INFORMATION SEGMENT

 N M1,PR

 S M0=$G(^PRC(442,VAR1,0)),M1=$G(^PRC(442,VAR1,1)),PR=$P(M1,U,8) S:$P(M0,U,19)=2 PR="N/A" S:PR="" VAR2="ERROR" W:PR="" !,"NOPR No PROPOSAL entry in file 442 for this P.O." Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCOEC3   1211     printed  Apr 09, 2024@21:16:45                                                                                                                                                                                                     Page 2

PRCOEC3   ;WISC/DJM-IFCAP SEGMENTS HE,MI ;11/24/93  15:03

V         ;;5.1;IFCAP;;Oct 20, 2000

 +1       ;Per VHA Directive 10-93-142, this routine should not be modified.

HE(VAR1,VAR2) ;PO HEADER INFORMATION SEGMENT

 +1        NEW A,A1,A12,DD,P,PHN,POD,X,Y

 +2        SET A=$GET(^PRC(442,VAR1,0))

           SET A1=$GET(^PRC(442,VAR1,1))

           SET A12=$GET(^PRC(442,VAR1,12))

           if A12=""

               SET VAR2="ERROR"

           if A12=""

               WRITE !,"NP12-No node 12 in file 442 for this P.O."

           if A12=""

               QUIT 

 +3        SET X=$PIECE(A1,U,15)

           if X=""

               SET VAR2="ERROR"

           if X=""

               WRITE !,"NPOD No purchase order date in file 442 for this P.O."

           if X=""

               QUIT 

 +4        SET X=$PIECE(A,U,10)

           if X=""

               SET VAR2="ERROR"

           if X=""

               WRITE !,"NDD No delivery date for this P.O. in file 442."

           if X=""

               QUIT 

           SET P=$PIECE(A1,U,10)

 +5        if P=""

               SET VAR2="ERROR"

           if P=""

               WRITE !,"NPPM No purchasing agent entry in file 442 for this P.O."

           if P=""

               QUIT 

 +6        SET PHN=$PIECE($GET(^VA(200,P,.13)),"^",5)

           IF PHN=""

               IF '$GET(PRCHPC)

                   SET VAR2="ERROR"

                   WRITE !,"NPHN No phone number node in the person file for this PPM."

 +7        SET PHN=$PIECE(PHN,U)

           IF PHN=""

               IF '$GET(PRCHPC)

                   SET VAR2="ERROR"

                   WRITE !,"NPH No phone number for this PPM in the person file."

 +8        QUIT 

MI(VAR1,VAR2) ;MISCELLANEOUS INFORMATION SEGMENT

 +1        NEW M1,PR

 +2        SET M0=$GET(^PRC(442,VAR1,0))

           SET M1=$GET(^PRC(442,VAR1,1))

           SET PR=$PIECE(M1,U,8)

           if $PIECE(M0,U,19)=2

               SET PR="N/A"

           if PR=""

               SET VAR2="ERROR"

           if PR=""

               WRITE !,"NOPR No PROPOSAL entry in file 442 for this P.O."

           QUIT