- 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 ---[H[J[2J[HPRCOEC3 1211 printed Feb 18, 2025@23:38:11 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