- PRCOEC2 ;WISC/DJM-IFCAP SEGMENTS IT,DE ;7/8/96 9:37 AM
- V ;;5.1;IFCAP;;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- IT(VAR1,VAR2) ;ITEMS INFORMATION SEGMENT
- N AZ,DC,DE,DIS,DIWF,DIWL,DIWR,I0,I2,IT,ITEM,LI,LIN,OT,Q,TD,TOTAL,UC,UNIT,UP,UPN,X
- S A23=$G(^PRC(442,VAR1,23))
- I $P(A23,U,11)="P" S F1="" G IT0
- S A1=$G(^PRC(442,VAR1,1)),F1=$P(A1,U,7) S:F1="" VAR2="ERROR" W:F1="" !,"NSC-No SORCE CODE for this P.O." S F1=","_F1_",",F1=$S(",1,4,6,10,"[F1:"D",1:"")
- IT0 S (ITEM,ITEMCNT)=0,TOTAL=$P($G(^PRC(442,VAR1,2,0)),U,4)+7 F S ITEM=$O(^PRC(442,VAR1,2,ITEM)) Q:ITEM'>0 S ITEMCNT=ITEMCNT+1 D Q:VAR2]""
- .S I0=$G(^PRC(442,VAR1,2,ITEM,0)),I2=$G(^PRC(442,VAR1,2,ITEM,2)) S:I2="" VAR2="ERROR" W:I2="" !,"NI2N"_U_ITEM_"-No contract number for this P.O."
- IT1 .S Q=$P(I0,U,2) S:Q="" VAR2="ERROR" W:Q="" !,"NQTY"_U_$P(I0,U)_"-No quantity listed for this ITEM."
- .S UP=$P(I0,U,3) S:UP="" VAR2="ERROR" W:UP="" !,"NUOP"_U_$P(I0,U)_"-No unit of purchase pointer for this ITEM."
- .I UP'="" S UPN=$G(^PRCD(420.5,UP,0)) S:UPN="" VAR2="ERROR" W:UPN="" !,"NUPN"_U_$P(I0,U)_"-No entry in unit of issue file for unit of purchase pointer in",!,"ITEM entry in P.O. file."
- .I $G(UPN)'="" S UNIT=$P(UPN,U) S:UNIT="" VAR2="ERROR" W:UNIT="" !,"NUNI"_U_$P(I0,U)_"-No name entry in unit of purchase file for unit of",!,"purchase pointer in ITEM entry in P.O. file."
- .S UC=$P(I0,U,9) S:UC="" VAR2="ERROR" W:UC="" !,"NAUC"_U_$P(I0,U)_"-No actual unit cost for this ITEM."
- IT2 .S LIN=$P(I0,U),(DIS,TD)=0 F S DIS=$O(^PRC(442,VAR1,3,DIS)) G:DIS'>0 IT3 S DC=$G(^PRC(442,VAR1,3,DIS,0)),LI=$P(DC,U,6) Q:LIN=LI
- IT3 .S CN=$P(I2,U,2) I F1="D",CN="" S VAR2="ERROR" W !,"NCNO"_U_$P(I0,U)_"-This order requires a contract number but none was entered",!,"for this ITEM."
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCOEC2 1790 printed Feb 18, 2025@23:38:10 Page 2
- PRCOEC2 ;WISC/DJM-IFCAP SEGMENTS IT,DE ;7/8/96 9:37 AM
- V ;;5.1;IFCAP;;Oct 20, 2000
- +1 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +2 ;
- IT(VAR1,VAR2) ;ITEMS INFORMATION SEGMENT
- +1 NEW AZ,DC,DE,DIS,DIWF,DIWL,DIWR,I0,I2,IT,ITEM,LI,LIN,OT,Q,TD,TOTAL,UC,UNIT,UP,UPN,X
- +2 SET A23=$GET(^PRC(442,VAR1,23))
- +3 IF $PIECE(A23,U,11)="P"
- SET F1=""
- GOTO IT0
- +4 SET A1=$GET(^PRC(442,VAR1,1))
- SET F1=$PIECE(A1,U,7)
- if F1=""
- SET VAR2="ERROR"
- if F1=""
- WRITE !,"NSC-No SORCE CODE for this P.O."
- SET F1=","_F1_","
- SET F1=$SELECT(",1,4,6,10,"[F1:"D",1:"")
- IT0 SET (ITEM,ITEMCNT)=0
- SET TOTAL=$PIECE($GET(^PRC(442,VAR1,2,0)),U,4)+7
- FOR
- SET ITEM=$ORDER(^PRC(442,VAR1,2,ITEM))
- if ITEM'>0
- QUIT
- SET ITEMCNT=ITEMCNT+1
- Begin DoDot:1
- +1 SET I0=$GET(^PRC(442,VAR1,2,ITEM,0))
- SET I2=$GET(^PRC(442,VAR1,2,ITEM,2))
- if I2=""
- SET VAR2="ERROR"
- if I2=""
- WRITE !,"NI2N"_U_ITEM_"-No contract number for this P.O."
- IT1 SET Q=$PIECE(I0,U,2)
- if Q=""
- SET VAR2="ERROR"
- if Q=""
- WRITE !,"NQTY"_U_$PIECE(I0,U)_"-No quantity listed for this ITEM."
- +1 SET UP=$PIECE(I0,U,3)
- if UP=""
- SET VAR2="ERROR"
- if UP=""
- WRITE !,"NUOP"_U_$PIECE(I0,U)_"-No unit of purchase pointer for this ITEM."
- +2 IF UP'=""
- SET UPN=$GET(^PRCD(420.5,UP,0))
- if UPN=""
- SET VAR2="ERROR"
- if UPN=""
- WRITE !,"NUPN"_U_$PIECE(I0,U)_"-No entry in unit of issue file for unit of purchase pointer in",!,"ITEM entry in P.O. file."
- +3 IF $GET(UPN)'=""
- SET UNIT=$PIECE(UPN,U)
- if UNIT=""
- SET VAR2="ERROR"
- if UNIT=""
- WRITE !,"NUNI"_U_$PIECE(I0,U)_"-No name entry in unit of purchase file for unit of",!,"purchase pointer in ITEM entry in P.O. file."
- +4 SET UC=$PIECE(I0,U,9)
- if UC=""
- SET VAR2="ERROR"
- if UC=""
- WRITE !,"NAUC"_U_$PIECE(I0,U)_"-No actual unit cost for this ITEM."
- IT2 SET LIN=$PIECE(I0,U)
- SET (DIS,TD)=0
- FOR
- SET DIS=$ORDER(^PRC(442,VAR1,3,DIS))
- if DIS'>0
- GOTO IT3
- SET DC=$GET(^PRC(442,VAR1,3,DIS,0))
- SET LI=$PIECE(DC,U,6)
- if LIN=LI
- QUIT
- IT3 SET CN=$PIECE(I2,U,2)
- IF F1="D"
- IF CN=""
- SET VAR2="ERROR"
- WRITE !,"NCNO"_U_$PIECE(I0,U)_"-This order requires a contract number but none was entered",!,"for this ITEM."
- End DoDot:1
- if VAR2]""
- QUIT
- +1 QUIT