- PRCPDAP3 ;WISC/RFJ-drug accountability/prime vendor (print items) ;15 Mar 94
- ;;5.1;IFCAP;;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- Q
- ;
- ;
- LINEITEM ; print line items
- D H1
- S (LINEITEM,TOTAL)=0 F S LINEITEM=$O(^TMP($J,"PRCPDAPV SET",STCTRL,"IT",LINEITEM)) Q:'LINEITEM!($G(PRCPFLAG)) S DATA=^(LINEITEM) D
- . I $Y>(IOSL-8) D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG) D H,H1
- . S TOTCOST=$J($P(DATA,"^")*$P(DATA,"^",3),0,2),TOTAL=TOTAL+TOTCOST
- . W !,LINEITEM,?10,$P(DATA,"^",4),?30,$E($P(DATA,"^",5),1,14),?44,$J($P(DATA,"^"),8),$J($P(DATA,"^",2),6),$J($P(DATA,"^",3),10,2),$J(TOTCOST,12,2)
- . I $D(^TMP($J,"PRCPDAPV SET",STCTRL,"IT",LINEITEM,"E")) W !?3,^("E") Q
- . S ITEMDA=+$P(DATA,"^",6),VENDA=+$P(DATA,"^",7)
- . S VENDATA=$G(^PRC(441,ITEMDA,2,VENDA,0))
- . W !,?10,$E($$DESCR^PRCPUX1(0,ITEMDA),1,25),?35,"(#",ITEMDA,")",?45,"VN# ",VENDA,?54,$J($$UNITCODE^PRCPUX1(+$P(VENDATA,"^",7)),4),$J($P(VENDATA,"^",2),10,2)
- . I $D(^TMP($J,"PRCPDAPV SET",STCTRL,"IT",LINEITEM,"E1")) W !?3,^("E1")
- . I $D(^TMP($J,"PRCPDAPV SET",STCTRL,"IT",LINEITEM,"E2")) W !?3,^("E2")
- . W !
- I $G(PRCPFLAG) Q
- I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG) D H
- W !?68,"------------",!?10,"* * * * * T O T A L C O S T - - - - - - >",?68,$J(TOTAL,12,2)
- I '$D(^TMP($J,"PRCPDAPV SET",STCTRL,"RIL")) K X S X(1)="REPETITIVE ITEM LIST NOT BUILT" D DISPLAY^PRCPUX2(1,80,.X) D:SCREEN P^PRCPUREP Q
- W !!,"* * * * R E P E T I T I V E I T E M L I S T :",$J(^TMP($J,"PRCPDAPV SET",STCTRL,"RIL"),29)
- D:SCREEN P^PRCPUREP
- Q
- ;
- ;
- H1 ; item header
- W !!?10,"* * * * * I N V O I C E L I N E I T E M S * * * * *"
- W !,"LN",?10,"NDC (6-4-2)",?30,"VENDOR NUMBER",?44,$J("QTY",8),$J("UNIT",6),$J("UNITCOST",10),$J("TOTALCOST",12)
- Q
- ;
- ;
- H S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
- W $C(13),"PRIME VENDOR UPLOAD REPORT",?(80-$L(%)),%
- S %="",$P(%,"-",81)=""
- W !," SET CONTROL NUMBER: ",STCTRL,!,%
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPDAP3 2005 printed Feb 18, 2025@23:39:48 Page 2
- PRCPDAP3 ;WISC/RFJ-drug accountability/prime vendor (print items) ;15 Mar 94
- +1 ;;5.1;IFCAP;;Oct 20, 2000
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 QUIT
- +4 ;
- +5 ;
- LINEITEM ; print line items
- +1 DO H1
- +2 SET (LINEITEM,TOTAL)=0
- FOR
- SET LINEITEM=$ORDER(^TMP($JOB,"PRCPDAPV SET",STCTRL,"IT",LINEITEM))
- if 'LINEITEM!($GET(PRCPFLAG))
- QUIT
- SET DATA=^(LINEITEM)
- Begin DoDot:1
- +3 IF $Y>(IOSL-8)
- if SCREEN
- DO P^PRCPUREP
- if $GET(PRCPFLAG)
- QUIT
- DO H
- DO H1
- +4 SET TOTCOST=$JUSTIFY($PIECE(DATA,"^")*$PIECE(DATA,"^",3),0,2)
- SET TOTAL=TOTAL+TOTCOST
- +5 WRITE !,LINEITEM,?10,$PIECE(DATA,"^",4),?30,$EXTRACT($PIECE(DATA,"^",5),1,14),?44,$JUSTIFY($PIECE(DATA,"^"),8),$JUSTIFY($PIECE(DATA,"^",2),6),$JUSTIFY($PIECE(DATA,"^",3),10,2),$JUSTIFY(TOTCOST,12,2)
- +6 IF $DATA(^TMP($JOB,"PRCPDAPV SET",STCTRL,"IT",LINEITEM,"E"))
- WRITE !?3,^("E")
- QUIT
- +7 SET ITEMDA=+$PIECE(DATA,"^",6)
- SET VENDA=+$PIECE(DATA,"^",7)
- +8 SET VENDATA=$GET(^PRC(441,ITEMDA,2,VENDA,0))
- +9 WRITE !,?10,$EXTRACT($$DESCR^PRCPUX1(0,ITEMDA),1,25),?35,"(#",ITEMDA,")",?45,"VN# ",VENDA,?54,$JUSTIFY($$UNITCODE^PRCPUX1(+$PIECE(VENDATA,"^",7)),4),$JUSTIFY($PIECE(VENDATA,"^",2),10,2)
- +10 IF $DATA(^TMP($JOB,"PRCPDAPV SET",STCTRL,"IT",LINEITEM,"E1"))
- WRITE !?3,^("E1")
- +11 IF $DATA(^TMP($JOB,"PRCPDAPV SET",STCTRL,"IT",LINEITEM,"E2"))
- WRITE !?3,^("E2")
- +12 WRITE !
- End DoDot:1
- +13 IF $GET(PRCPFLAG)
- QUIT
- +14 IF $Y>(IOSL-6)
- if SCREEN
- DO P^PRCPUREP
- if $GET(PRCPFLAG)
- QUIT
- DO H
- +15 WRITE !?68,"------------",!?10,"* * * * * T O T A L C O S T - - - - - - >",?68,$JUSTIFY(TOTAL,12,2)
- +16 IF '$DATA(^TMP($JOB,"PRCPDAPV SET",STCTRL,"RIL"))
- KILL X
- SET X(1)="REPETITIVE ITEM LIST NOT BUILT"
- DO DISPLAY^PRCPUX2(1,80,.X)
- if SCREEN
- DO P^PRCPUREP
- QUIT
- +17 WRITE !!,"* * * * R E P E T I T I V E I T E M L I S T :",$JUSTIFY(^TMP($JOB,"PRCPDAPV SET",STCTRL,"RIL"),29)
- +18 if SCREEN
- DO P^PRCPUREP
- +19 QUIT
- +20 ;
- +21 ;
- H1 ; item header
- +1 WRITE !!?10,"* * * * * I N V O I C E L I N E I T E M S * * * * *"
- +2 WRITE !,"LN",?10,"NDC (6-4-2)",?30,"VENDOR NUMBER",?44,$JUSTIFY("QTY",8),$JUSTIFY("UNIT",6),$JUSTIFY("UNITCOST",10),$JUSTIFY("TOTALCOST",12)
- +3 QUIT
- +4 ;
- +5 ;
- H SET %=NOW_" PAGE "_PAGE
- SET PAGE=PAGE+1
- IF PAGE'=2!(SCREEN)
- WRITE @IOF
- +1 WRITE $CHAR(13),"PRIME VENDOR UPLOAD REPORT",?(80-$LENGTH(%)),%
- +2 SET %=""
- SET $PIECE(%,"-",81)=""
- +3 WRITE !," SET CONTROL NUMBER: ",STCTRL,!,%
- +4 QUIT
