- PRCPRIB1 ;WISC/RFJ-issue book request form (print ^tmp) ;22 Dec 92
- ;;5.1;IFCAP;;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- Q
- ;
- ;
- PRINT ; print form
- S (PAGE,TOTAL)=0,SCREEN=$$SCRPAUSE^PRCPUREP U IO D H,H1,H2
- S DESCNSN="" F S DESCNSN=$O(^TMP($J,"PRCPRIB",DESCNSN)) Q:DESCNSN=""!($G(PRCPFLAG)) S LINEITEM=0 F S LINEITEM=$O(^TMP($J,"PRCPRIB",DESCNSN,LINEITEM)) Q:'LINEITEM!($G(PRCPFLAG)) D
- . S LINEDA=0 F S LINEDA=$O(^TMP($J,"PRCPRIB",DESCNSN,LINEITEM,LINEDA)) Q:'LINEDA!($G(PRCPFLAG)) S D=^(LINEDA) D
- . . S DATA=$G(^PRCS(410,PRCPDA,"IT",LINEDA,0))
- . . W !!,$J(LINEITEM,4),?7,$P(DATA,"^",5)," ",$E($P(D,"^",7),1,15-$L($P(DATA,"^",5)))
- . . W ?27,$P(D,"^"),$J($P(D,"^",2),8),$J($P(DATA,"^",7),12,3),$J($P(D,"^",3),9),$J($P(DATA,"^",2),9),$P(D,"^",6)
- . . W !?7,$P(D,"^",8)
- . . I $P(D,"^",4) W ?27,"Temp Stock Level: ",$P(D,"^",4)
- . . I $P(D,"^",5) W ?25," Req Issue Mult: ",$P(D,"^",5)
- . . S TOTAL=TOTAL+($P(DATA,"^",2)*$P(DATA,"^",7))
- . . I $Y>(IOSL-7) D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG) D H,H2
- I $G(PRCPFLAG) Q
- I $Y>(IOSL-4) D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG) D H,H2
- S %="",$P(%,"_",81)="" W !?49,"TOTAL: ",$J(TOTAL,11,2),!,%
- I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG) D H
- W !,"Special Remarks:"
- S LINEDA=0 F S LINEDA=$O(^PRCS(410,PRCPDA,"RM",LINEDA)) Q:'LINEDA!($G(PRCPFLAG)) S D=$G(^(LINEDA,0)) I D'="" D
- . I $Y>(IOSL-3) D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG) D H W !,"Special Remarks (continued):"
- . W !,D
- I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG) D H
- W !,"Justification:"
- S LINEDA=0 F S LINEDA=$O(^PRCS(410,PRCPDA,8,LINEDA)) Q:'LINEDA!($G(PRCPFLAG)) S D=$G(^(LINEDA,0)) I D'="" D
- . I $Y>(IOSL-3) D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG) D H W !,"Justification (continued):"
- . W !,D
- I $G(PRCPFLAG) Q
- I $Y>(IOSL-8) D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG) D H
- W !,%,!,"Control Point Official:",?40,"|Signature/Date Signed:",!,$E($P($G(^VA(200,+$P(TRANDAT7,"^",3),20)),"^",2),1,38)
- S X=$$DECODE^PRCSC1(PRCPDA) W ?40,"|/ES/|",$E(X,1,22)
- S Y=$P(TRANDAT7,"^",5) S:'Y Y=$P(TRANDAT7,"^",7) D DD^%DT W ?68,"/",Y
- S %="",$P(%,"_",41)="|",$P(%,"_",80)=""
- W !,%,!,"Approved by:",?34,"Date",?40,"|Obligated by:",?74,"Date"
- W !,%,!,"Storekeeper:",?34,"Date",?40,"|Responsible Official:",?74,"Date",!,%,!
- D END^PRCPUREP
- Q
- ;
- ;
- H S %="",$P(%,"_",81)="",PAGE=PAGE+1 I PAGE'=1!(SCREEN) W @IOF
- W $C(13),?29,"PRIORITY: ",$P(TRANDAT1,"^",3),!,NOW W:$P(TRANDATA,"^",3)'="" ?20,"TEMP.TRANS#:",$P(TRANDATA,"^",3) W ?45,$P(TRANDATA,"^"),?71,"PAGE ",PAGE,!,%
- W !?27,$S($P(TRANDATA,"^",7)=1:"*INTERVAL ISSUE",1:"*ISSUE BOOK")," REQUEST*",!,%
- Q
- ;
- ;
- H1 N % S %="",$P(%,"_",25)="|",$P(%,"_",54)="|",$P(%,"_",79)=""
- W !,"Station: ",+TRANDATA,?24,"|Dept: ",$E(DEPART,1,21),?54,"|Voucher #",!,%
- W !,"Control Pt : ",$E($P(TRANDAT3,"^"),1,26),?40,"|Request Date: ",$P(TRANDAT1,"^")
- W !,"Cost Center: ",$E($P(TRANDAT3,"^",3),1,26),?40,"|Delivery Date: ",$P(TRANDAT1,"^",4)
- W !,"Deliver To : ",$E($P(TRANDAT9,"^"),1,26),?40,"|Requestor : ",USER
- S %="",$P(%,"_",41)="|",$P(%,"_",80)=""
- W !,"Classification Of Request: ",$E(CLASS,1,12),?40,"| (*--OVER LEVEL OR ISSUE MULT.)",!,% Q
- ;
- ;
- H2 N % S %="",$P(%,"_",81)=""
- W !,"LINE",?7,"DESCRIPTION",?25,"UNIT",?32,"LEVEL",?39,"UNIT PRICE",?51,"ON HAND",?60,"ORD QTY",?71,"QTY DELIV",!,% Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPRIB1 3417 printed Jan 18, 2025@03:16:07 Page 2
- PRCPRIB1 ;WISC/RFJ-issue book request form (print ^tmp) ;22 Dec 92
- +1 ;;5.1;IFCAP;;Oct 20, 2000
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 QUIT
- +4 ;
- +5 ;
- PRINT ; print form
- +1 SET (PAGE,TOTAL)=0
- SET SCREEN=$$SCRPAUSE^PRCPUREP
- USE IO
- DO H
- DO H1
- DO H2
- +2 SET DESCNSN=""
- FOR
- SET DESCNSN=$ORDER(^TMP($JOB,"PRCPRIB",DESCNSN))
- if DESCNSN=""!($GET(PRCPFLAG))
- QUIT
- SET LINEITEM=0
- FOR
- SET LINEITEM=$ORDER(^TMP($JOB,"PRCPRIB",DESCNSN,LINEITEM))
- if 'LINEITEM!($GET(PRCPFLAG))
- QUIT
- Begin DoDot:1
- +3 SET LINEDA=0
- FOR
- SET LINEDA=$ORDER(^TMP($JOB,"PRCPRIB",DESCNSN,LINEITEM,LINEDA))
- if 'LINEDA!($GET(PRCPFLAG))
- QUIT
- SET D=^(LINEDA)
- Begin DoDot:2
- +4 SET DATA=$GET(^PRCS(410,PRCPDA,"IT",LINEDA,0))
- +5 WRITE !!,$JUSTIFY(LINEITEM,4),?7,$PIECE(DATA,"^",5)," ",$EXTRACT($PIECE(D,"^",7),1,15-$LENGTH($PIECE(DATA,"^",5)))
- +6 WRITE ?27,$PIECE(D,"^"),$JUSTIFY($PIECE(D,"^",2),8),$JUSTIFY($PIECE(DATA,"^",7),12,3),$JUSTIFY($PIECE(D,"^",3),9),$JUSTIFY($PIECE(DATA,"^",2),9),$PIECE(D,"^",6)
- +7 WRITE !?7,$PIECE(D,"^",8)
- +8 IF $PIECE(D,"^",4)
- WRITE ?27,"Temp Stock Level: ",$PIECE(D,"^",4)
- +9 IF $PIECE(D,"^",5)
- WRITE ?25," Req Issue Mult: ",$PIECE(D,"^",5)
- +10 SET TOTAL=TOTAL+($PIECE(DATA,"^",2)*$PIECE(DATA,"^",7))
- +11 IF $Y>(IOSL-7)
- if SCREEN
- DO P^PRCPUREP
- if $GET(PRCPFLAG)
- QUIT
- DO H
- DO H2
- End DoDot:2
- End DoDot:1
- +12 IF $GET(PRCPFLAG)
- QUIT
- +13 IF $Y>(IOSL-4)
- if SCREEN
- DO P^PRCPUREP
- if $GET(PRCPFLAG)
- QUIT
- DO H
- DO H2
- +14 SET %=""
- SET $PIECE(%,"_",81)=""
- WRITE !?49,"TOTAL: ",$JUSTIFY(TOTAL,11,2),!,%
- +15 IF $Y>(IOSL-6)
- if SCREEN
- DO P^PRCPUREP
- if $GET(PRCPFLAG)
- QUIT
- DO H
- +16 WRITE !,"Special Remarks:"
- +17 SET LINEDA=0
- FOR
- SET LINEDA=$ORDER(^PRCS(410,PRCPDA,"RM",LINEDA))
- if 'LINEDA!($GET(PRCPFLAG))
- QUIT
- SET D=$GET(^(LINEDA,0))
- IF D'=""
- Begin DoDot:1
- +18 IF $Y>(IOSL-3)
- if SCREEN
- DO P^PRCPUREP
- if $GET(PRCPFLAG)
- QUIT
- DO H
- WRITE !,"Special Remarks (continued):"
- +19 WRITE !,D
- End DoDot:1
- +20 IF $Y>(IOSL-6)
- if SCREEN
- DO P^PRCPUREP
- if $GET(PRCPFLAG)
- QUIT
- DO H
- +21 WRITE !,"Justification:"
- +22 SET LINEDA=0
- FOR
- SET LINEDA=$ORDER(^PRCS(410,PRCPDA,8,LINEDA))
- if 'LINEDA!($GET(PRCPFLAG))
- QUIT
- SET D=$GET(^(LINEDA,0))
- IF D'=""
- Begin DoDot:1
- +23 IF $Y>(IOSL-3)
- if SCREEN
- DO P^PRCPUREP
- if $GET(PRCPFLAG)
- QUIT
- DO H
- WRITE !,"Justification (continued):"
- +24 WRITE !,D
- End DoDot:1
- +25 IF $GET(PRCPFLAG)
- QUIT
- +26 IF $Y>(IOSL-8)
- if SCREEN
- DO P^PRCPUREP
- if $GET(PRCPFLAG)
- QUIT
- DO H
- +27 WRITE !,%,!,"Control Point Official:",?40,"|Signature/Date Signed:",!,$EXTRACT($PIECE($GET(^VA(200,+$PIECE(TRANDAT7,"^",3),20)),"^",2),1,38)
- +28 SET X=$$DECODE^PRCSC1(PRCPDA)
- WRITE ?40,"|/ES/|",$EXTRACT(X,1,22)
- +29 SET Y=$PIECE(TRANDAT7,"^",5)
- if 'Y
- SET Y=$PIECE(TRANDAT7,"^",7)
- DO DD^%DT
- WRITE ?68,"/",Y
- +30 SET %=""
- SET $PIECE(%,"_",41)="|"
- SET $PIECE(%,"_",80)=""
- +31 WRITE !,%,!,"Approved by:",?34,"Date",?40,"|Obligated by:",?74,"Date"
- +32 WRITE !,%,!,"Storekeeper:",?34,"Date",?40,"|Responsible Official:",?74,"Date",!,%,!
- +33 DO END^PRCPUREP
- +34 QUIT
- +35 ;
- +36 ;
- H SET %=""
- SET $PIECE(%,"_",81)=""
- SET PAGE=PAGE+1
- IF PAGE'=1!(SCREEN)
- WRITE @IOF
- +1 WRITE $CHAR(13),?29,"PRIORITY: ",$PIECE(TRANDAT1,"^",3),!,NOW
- if $PIECE(TRANDATA,"^",3)'=""
- WRITE ?20,"TEMP.TRANS#:",$PIECE(TRANDATA,"^",3)
- WRITE ?45,$PIECE(TRANDATA,"^"),?71,"PAGE ",PAGE,!,%
- +2 WRITE !?27,$SELECT($PIECE(TRANDATA,"^",7)=1:"*INTERVAL ISSUE",1:"*ISSUE BOOK")," REQUEST*",!,%
- +3 QUIT
- +4 ;
- +5 ;
- H1 NEW %
- SET %=""
- SET $PIECE(%,"_",25)="|"
- SET $PIECE(%,"_",54)="|"
- SET $PIECE(%,"_",79)=""
- +1 WRITE !,"Station: ",+TRANDATA,?24,"|Dept: ",$EXTRACT(DEPART,1,21),?54,"|Voucher #",!,%
- +2 WRITE !,"Control Pt : ",$EXTRACT($PIECE(TRANDAT3,"^"),1,26),?40,"|Request Date: ",$PIECE(TRANDAT1,"^")
- +3 WRITE !,"Cost Center: ",$EXTRACT($PIECE(TRANDAT3,"^",3),1,26),?40,"|Delivery Date: ",$PIECE(TRANDAT1,"^",4)
- +4 WRITE !,"Deliver To : ",$EXTRACT($PIECE(TRANDAT9,"^"),1,26),?40,"|Requestor : ",USER
- +5 SET %=""
- SET $PIECE(%,"_",41)="|"
- SET $PIECE(%,"_",80)=""
- +6 WRITE !,"Classification Of Request: ",$EXTRACT(CLASS,1,12),?40,"| (*--OVER LEVEL OR ISSUE MULT.)",!,%
- QUIT
- +7 ;
- +8 ;
- H2 NEW %
- SET %=""
- SET $PIECE(%,"_",81)=""
- +1 WRITE !,"LINE",?7,"DESCRIPTION",?25,"UNIT",?32,"LEVEL",?39,"UNIT PRICE",?51,"ON HAND",?60,"ORD QTY",?71,"QTY DELIV",!,%
- QUIT