- PRCPRPIQ ;WISC/RFJ-print picking ticket end of report ;07 Feb 92
- ;;5.1;IFCAP;;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- Q
- ;
- ;
- END ; come here to print at bottom of picking ticket
- N TEXT,X,Y
- S Y=$P($G(^PRCS(410,+TRANDA,3)),"^",2)
- S DATA(1)="SPECIAL INSTRUCTIONS/COMMENTS:",TEXT=2
- F X=1:1 Q:'$D(^PRCS(410,TRANDA,"RM",X,0)) S DATA(TEXT)=^(0),TEXT=TEXT+1
- F X=1:1 Q:'$D(^PRCS(410,TRANDA,"CO",X,0)) S DATA(TEXT)=^(0),TEXT=TEXT+1
- F X=1:1 S DATA=$P($T(DATA+X),";",3,99) Q:DATA="" S:DATA["xxxx" DATA=$TR(DATA,"x")_Y S DATA(TEXT)=DATA,TEXT=TEXT+1
- I $Y>(IOSL-TEXT) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H^PRCPRPIR
- W !!,"TOTAL DOLLAR AMOUNT OF TRANSACTION: ",$J(TOTAL,0,2)
- W !!,"INVENTORY AMOUNT OF TRANSACTION (BY ACCOUNT CODE):",! S X="" F %=1:1 S X=$O(ACCT(X)) Q:X="" W ?((%-1)*20),X," : ",$J(ACCT(X),0,2) I %=4 S %=0 W !
- I $Y>(IOSL-TEXT-1) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H^PRCPRPIR
- W ! S %=0 F S %=$O(DATA(%)) Q:'% W !,DATA(%)
- I '$D(PRCPFLAG) D END^PRCPUREP
- Q
- ;
- ;
- DATA ;; print signature at bottom of report
- ;;FUND CERTIFICATION--- THE SUPPLIES LISTED ON THIS REQUEST ARE PROPERLY
- ;;CHARGEABLE TO THE FOLLOWING ALLOTMENTS, THE AVAILABLE BALANCES OF WHICH
- ;;ARE SUFFICIENT TO COVER COST THEREOF, AND FUNDS HAVE BEEN OBLIGATED.
- ;;
- ;;APPROPRIATION AND ACCOUNTING SYMBOLS: xxxx
- ;;
- ;;OBLIGATED BY:______________________________ DATE:___________________
- ;;
- ;;SERVICE SIGNATURE:_________________________ PULLED BY:_______________
- ;;
- ;; TITLE:_________________________ VERIFIED BY:_______________
- ;;
- ;; DATE RECEIVED:_________________________ DATE TO DELIVER ON:_______________
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPRPIQ 1750 printed Feb 18, 2025@23:41:43 Page 2
- PRCPRPIQ ;WISC/RFJ-print picking ticket end of report ;07 Feb 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 ;
- END ; come here to print at bottom of picking ticket
- +1 NEW TEXT,X,Y
- +2 SET Y=$PIECE($GET(^PRCS(410,+TRANDA,3)),"^",2)
- +3 SET DATA(1)="SPECIAL INSTRUCTIONS/COMMENTS:"
- SET TEXT=2
- +4 FOR X=1:1
- if '$DATA(^PRCS(410,TRANDA,"RM",X,0))
- QUIT
- SET DATA(TEXT)=^(0)
- SET TEXT=TEXT+1
- +5 FOR X=1:1
- if '$DATA(^PRCS(410,TRANDA,"CO",X,0))
- QUIT
- SET DATA(TEXT)=^(0)
- SET TEXT=TEXT+1
- +6 FOR X=1:1
- SET DATA=$PIECE($TEXT(DATA+X),";",3,99)
- if DATA=""
- QUIT
- if DATA["xxxx"
- SET DATA=$TRANSLATE(DATA,"x")_Y
- SET DATA(TEXT)=DATA
- SET TEXT=TEXT+1
- +7 IF $Y>(IOSL-TEXT)
- if SCREEN
- DO P^PRCPUREP
- if $DATA(PRCPFLAG)
- QUIT
- DO H^PRCPRPIR
- +8 WRITE !!,"TOTAL DOLLAR AMOUNT OF TRANSACTION: ",$JUSTIFY(TOTAL,0,2)
- +9 WRITE !!,"INVENTORY AMOUNT OF TRANSACTION (BY ACCOUNT CODE):",!
- SET X=""
- FOR %=1:1
- SET X=$ORDER(ACCT(X))
- if X=""
- QUIT
- WRITE ?((%-1)*20),X," : ",$JUSTIFY(ACCT(X),0,2)
- IF %=4
- SET %=0
- WRITE !
- +10 IF $Y>(IOSL-TEXT-1)
- if SCREEN
- DO P^PRCPUREP
- if $DATA(PRCPFLAG)
- QUIT
- DO H^PRCPRPIR
- +11 WRITE !
- SET %=0
- FOR
- SET %=$ORDER(DATA(%))
- if '%
- QUIT
- WRITE !,DATA(%)
- +12 IF '$DATA(PRCPFLAG)
- DO END^PRCPUREP
- +13 QUIT
- +14 ;
- +15 ;
- DATA ;; print signature at bottom of report
- +1 ;;FUND CERTIFICATION--- THE SUPPLIES LISTED ON THIS REQUEST ARE PROPERLY
- +2 ;;CHARGEABLE TO THE FOLLOWING ALLOTMENTS, THE AVAILABLE BALANCES OF WHICH
- +3 ;;ARE SUFFICIENT TO COVER COST THEREOF, AND FUNDS HAVE BEEN OBLIGATED.
- +4 ;;
- +5 ;;APPROPRIATION AND ACCOUNTING SYMBOLS: xxxx
- +6 ;;
- +7 ;;OBLIGATED BY:______________________________ DATE:___________________
- +8 ;;
- +9 ;;SERVICE SIGNATURE:_________________________ PULLED BY:_______________
- +10 ;;
- +11 ;; TITLE:_________________________ VERIFIED BY:_______________
- +12 ;;
- +13 ;; DATE RECEIVED:_________________________ DATE TO DELIVER ON:_______________
