- PRCPRTR1 ;WISC/RFJ-transaction register report (print) ;07 Sep 91
- ;;5.1;IFCAP;**24,142**;Oct 20, 2000;Build 5
- ;Per VHA Directive 2004-038, this routine should not be modified.
- Q
- ;
- ;
- PRINT ;print report from tmp global
- N DATA,ITEMDA,MONTH,NOW,NOWDT,NSN,PAGE,PRCPFLAG,SALEUNIT,SCREEN,PRCPDT,HDSW
- D NOW^%DTC S (Y,NOWDT)=% D DD^%DT S NOW=Y,PAGE=0
- S HDSW=0,U="^",PAGE=0,ITEMDA="",SCREEN=$$SCRPAUSE^PRCPUREP U IO
- P1 S ITEMDA=$O(^TMP($J,"PRCPRTRA",ITEMDA)),PRCPDT=0 G 9:ITEMDA=""!($D(PRCPFLAG)) S:'$D(ALLITEMS) PAGE=0
- P2 S PRCPDT=$O(^TMP($J,"PRCPRTRA",ITEMDA,PRCPDT)) G P1:PRCPDT=""!$D(PRCPFLAG)
- S Y=PRCPDT D DD^%DT S MONTH=Y
- I $D(ALLITEMS),PAGE=0 D H
- D G 9:$G(PRCPFLAG),P2
- . I '$D(ALLITEMS) D H Q:$G(PRCPFLAG)
- . S DATA=^TMP($J,"PRCPRTRA",ITEMDA,PRCPDT),NSN=$P(DATA,U),DATA=$P(DATA,U,2,99)
- . W !!,$S(NSN=" ":"** NO NSN **",1:NSN)
- . W ?19,$P(DATA,"^")
- . W ?49,"[#",ITEMDA,"]"
- . W ?59,"U/I: ",$P(DATA,"^",2)
- . W ! W:PRCP("DPTYPE")="W" ?9,"QTY NON-ISS: ",+$P(DATA,"^",5)
- . W ?28,"DUE-IN: ",+$P(DATA,"^",3)
- . W ?44,"DUE-OUT: ",+$P(DATA,"^",4)
- . W !?23,"ISSUABLE + NONISSUABLE OPEN BALANCE:",$J($P(DATA,"^",6),9),$J($P(DATA,"^",7),12,2)
- . I $Y>(IOSL-6) D H Q:$G(PRCPFLAG)
- . S DATE=0
- . F S DATE=$O(^TMP($J,"PRCPRTRA",ITEMDA,PRCPDT,DATE)) Q:'DATE!($G(PRCPFLAG)) D
- . . S TRX=0
- . . F S TRX=$O(^TMP($J,"PRCPRTRA",ITEMDA,PRCPDT,DATE,TRX)) Q:'TRX!($G(PRCPFLAG)) D
- . . . S D=^TMP($J,"PRCPRTRA",ITEMDA,PRCPDT,DATE,TRX)
- . . . S SALEUNIT="" I $P(D,"^",6) S SALEUNIT=$J($P(D,"^",5)/$P(D,"^",6),0,3)
- . . . W !,$P(D,"^"),?9,$E(DATE,6,7),?13,$P(D,"^",2),?33,$J($P(D,"^",3),8),$J(SALEUNIT,10),$J($P(D,"^",5),10),$J($P(D,"^",6),7),$J($P(D,"^",4),12)
- . . . W:$G(^PRCP(445.2,TRX,1))'="" !,$P(^(1),"^")
- . . . I $Y>(IOSL-6) D H Q:$G(PRCPFLAG)
- . I $D(PRCPFLAG) Q
- . I $Y>(IOSL-5) D H Q:$G(PRCPFLAG)
- . I $G(ZTQUEUED),$$S^%ZTLOAD S PRCPFLAG=1 W !?10,"<<< TASKMANAGER JOB TERMINATED BY USER >>>" Q
- . W !?43,"CLOSING BALANCE:",$J($P(DATA,"^",8),9),$J($P(DATA,"^",9),12,2)
- . S %=$G(^TMP($J,"PRCPRTRA",ITEMDA,PRCPDT,"BAL"))
- . I %'="" W !?28,"*** CURRENT INVENTORY BALANCES:",$J($P(%,"^"),9),$J($P(%,"^",2),12,2)
- . I $Y>(IOSL-6) D H
- 9 I $G(PRCPFLAG) G Q
- I $Y>(IOSL-7),'$D(PRCPFLAG) D H Q:$G(PRCPFLAG)
- I '$D(PRCPFLAG) W ! F %=1:1:5 W !,$P($T(ABBREV+%),";",3)
- I '$D(PRCPFLAG) D END^PRCPUREP
- Q D ^%ZISC K ^TMP($J,"PRCPITEMS"),^TMP($J,"PRCPRTRA")
- Q
- ;
- H S PAGE=PAGE+1,%=NOW_" PAGE "_PAGE
- I SCREEN D:PAGE>1!HDSW P^PRCPUREP Q:$G(PRCPFLAG) W @IOF
- I 'SCREEN,(PAGE=1!$D(ALLITEMS)) W @IOF
- I 'SCREEN,PAGE>1,'$D(ALLITEMS) S X="",$P(X," ",81)="" W !,X,!,X K X
- W !,"TRANSACTION REGISTER FOR ",$E(PRCP("IN"),1,15),?(80-$L(%)),%
- W !," FOR THE MONTH OF ",MONTH
- I $G(PRCPSUMM) W ?47,"ONLY ITEMS OUT OF BALANCE PRINTED"
- W !,"NSN",?19,"DESCRIPTION",?49,"[#MI]"
- S %="",$P(%,"-",81)="",HDSW=1
- W !,"TRANSID",?9,"DT",?13,"TRANS./P.O."
- W:PRCP("DPTYPE")="P" "/to:INV.PT."
- W ?38,"U/I",?43,"SELLUNIT",?55,"SELL $",?65,"QTY",?75,"INV $",!,%
- I 'SCREEN S $Y=9
- Q
- ;
- ABBREV ;;display abbreviations
- ;;TRANSACTION TYPE (TT) ABBREVIATIONS: U = USAGE
- ;; R = RECEIVING A = MANUAL ADJUSTMENT
- ;; D = DISTRIBUTION (REGULAR ISSUES) S = ASSEMBLE SETS
- ;; C = DISTRIBUTION (CALL-IN) P = PHYSICAL COUNT
- ;; E = DISTRIBUTION (EMERGENCY) Q = QTY ADJ TO SUPPLY STATION
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPRTR1 3366 printed Feb 18, 2025@23:41:59 Page 2
- PRCPRTR1 ;WISC/RFJ-transaction register report (print) ;07 Sep 91
- +1 ;;5.1;IFCAP;**24,142**;Oct 20, 2000;Build 5
- +2 ;Per VHA Directive 2004-038, this routine should not be modified.
- +3 QUIT
- +4 ;
- +5 ;
- PRINT ;print report from tmp global
- +1 NEW DATA,ITEMDA,MONTH,NOW,NOWDT,NSN,PAGE,PRCPFLAG,SALEUNIT,SCREEN,PRCPDT,HDSW
- +2 DO NOW^%DTC
- SET (Y,NOWDT)=%
- DO DD^%DT
- SET NOW=Y
- SET PAGE=0
- +3 SET HDSW=0
- SET U="^"
- SET PAGE=0
- SET ITEMDA=""
- SET SCREEN=$$SCRPAUSE^PRCPUREP
- USE IO
- P1 SET ITEMDA=$ORDER(^TMP($JOB,"PRCPRTRA",ITEMDA))
- SET PRCPDT=0
- if ITEMDA=""!($DATA(PRCPFLAG))
- GOTO 9
- if '$DATA(ALLITEMS)
- SET PAGE=0
- P2 SET PRCPDT=$ORDER(^TMP($JOB,"PRCPRTRA",ITEMDA,PRCPDT))
- if PRCPDT=""!$DATA(PRCPFLAG)
- GOTO P1
- +1 SET Y=PRCPDT
- DO DD^%DT
- SET MONTH=Y
- +2 IF $DATA(ALLITEMS)
- IF PAGE=0
- DO H
- +3 Begin DoDot:1
- +4 IF '$DATA(ALLITEMS)
- DO H
- if $GET(PRCPFLAG)
- QUIT
- +5 SET DATA=^TMP($JOB,"PRCPRTRA",ITEMDA,PRCPDT)
- SET NSN=$PIECE(DATA,U)
- SET DATA=$PIECE(DATA,U,2,99)
- +6 WRITE !!,$SELECT(NSN=" ":"** NO NSN **",1:NSN)
- +7 WRITE ?19,$PIECE(DATA,"^")
- +8 WRITE ?49,"[#",ITEMDA,"]"
- +9 WRITE ?59,"U/I: ",$PIECE(DATA,"^",2)
- +10 WRITE !
- if PRCP("DPTYPE")="W"
- WRITE ?9,"QTY NON-ISS: ",+$PIECE(DATA,"^",5)
- +11 WRITE ?28,"DUE-IN: ",+$PIECE(DATA,"^",3)
- +12 WRITE ?44,"DUE-OUT: ",+$PIECE(DATA,"^",4)
- +13 WRITE !?23,"ISSUABLE + NONISSUABLE OPEN BALANCE:",$JUSTIFY($PIECE(DATA,"^",6),9),$JUSTIFY($PIECE(DATA,"^",7),12,2)
- +14 IF $Y>(IOSL-6)
- DO H
- if $GET(PRCPFLAG)
- QUIT
- +15 SET DATE=0
- +16 FOR
- SET DATE=$ORDER(^TMP($JOB,"PRCPRTRA",ITEMDA,PRCPDT,DATE))
- if 'DATE!($GET(PRCPFLAG))
- QUIT
- Begin DoDot:2
- +17 SET TRX=0
- +18 FOR
- SET TRX=$ORDER(^TMP($JOB,"PRCPRTRA",ITEMDA,PRCPDT,DATE,TRX))
- if 'TRX!($GET(PRCPFLAG))
- QUIT
- Begin DoDot:3
- +19 SET D=^TMP($JOB,"PRCPRTRA",ITEMDA,PRCPDT,DATE,TRX)
- +20 SET SALEUNIT=""
- IF $PIECE(D,"^",6)
- SET SALEUNIT=$JUSTIFY($PIECE(D,"^",5)/$PIECE(D,"^",6),0,3)
- +21 WRITE !,$PIECE(D,"^"),?9,$EXTRACT(DATE,6,7),?13,$PIECE(D,"^",2),?33,$JUSTIFY($PIECE(D,"^",3),8),$JUSTIFY(SALEUNIT,10),$JUSTIFY($PIECE(D,"^",5),10),$JUSTIFY($PIECE(D,"^",6),7),$JUSTIFY($PIECE(D,"^",4),12)
- +22 if $GET(^PRCP(445.2,TRX,1))'=""
- WRITE !,$PIECE(^(1),"^")
- +23 IF $Y>(IOSL-6)
- DO H
- if $GET(PRCPFLAG)
- QUIT
- End DoDot:3
- End DoDot:2
- +24 IF $DATA(PRCPFLAG)
- QUIT
- +25 IF $Y>(IOSL-5)
- DO H
- if $GET(PRCPFLAG)
- QUIT
- +26 IF $GET(ZTQUEUED)
- IF $$S^%ZTLOAD
- SET PRCPFLAG=1
- WRITE !?10,"<<< TASKMANAGER JOB TERMINATED BY USER >>>"
- QUIT
- +27 WRITE !?43,"CLOSING BALANCE:",$JUSTIFY($PIECE(DATA,"^",8),9),$JUSTIFY($PIECE(DATA,"^",9),12,2)
- +28 SET %=$GET(^TMP($JOB,"PRCPRTRA",ITEMDA,PRCPDT,"BAL"))
- +29 IF %'=""
- WRITE !?28,"*** CURRENT INVENTORY BALANCES:",$JUSTIFY($PIECE(%,"^"),9),$JUSTIFY($PIECE(%,"^",2),12,2)
- +30 IF $Y>(IOSL-6)
- DO H
- End DoDot:1
- if $GET(PRCPFLAG)
- GOTO 9
- GOTO P2
- 9 IF $GET(PRCPFLAG)
- GOTO Q
- +1 IF $Y>(IOSL-7)
- IF '$DATA(PRCPFLAG)
- DO H
- if $GET(PRCPFLAG)
- QUIT
- +2 IF '$DATA(PRCPFLAG)
- WRITE !
- FOR %=1:1:5
- WRITE !,$PIECE($TEXT(ABBREV+%),";",3)
- +3 IF '$DATA(PRCPFLAG)
- DO END^PRCPUREP
- Q DO ^%ZISC
- KILL ^TMP($JOB,"PRCPITEMS"),^TMP($JOB,"PRCPRTRA")
- +1 QUIT
- +2 ;
- H SET PAGE=PAGE+1
- SET %=NOW_" PAGE "_PAGE
- +1 IF SCREEN
- if PAGE>1!HDSW
- DO P^PRCPUREP
- if $GET(PRCPFLAG)
- QUIT
- WRITE @IOF
- +2 IF 'SCREEN
- IF (PAGE=1!$DATA(ALLITEMS))
- WRITE @IOF
- +3 IF 'SCREEN
- IF PAGE>1
- IF '$DATA(ALLITEMS)
- SET X=""
- SET $PIECE(X," ",81)=""
- WRITE !,X,!,X
- KILL X
- +4 WRITE !,"TRANSACTION REGISTER FOR ",$EXTRACT(PRCP("IN"),1,15),?(80-$LENGTH(%)),%
- +5 WRITE !," FOR THE MONTH OF ",MONTH
- +6 IF $GET(PRCPSUMM)
- WRITE ?47,"ONLY ITEMS OUT OF BALANCE PRINTED"
- +7 WRITE !,"NSN",?19,"DESCRIPTION",?49,"[#MI]"
- +8 SET %=""
- SET $PIECE(%,"-",81)=""
- SET HDSW=1
- +9 WRITE !,"TRANSID",?9,"DT",?13,"TRANS./P.O."
- +10 if PRCP("DPTYPE")="P"
- WRITE "/to:INV.PT."
- +11 WRITE ?38,"U/I",?43,"SELLUNIT",?55,"SELL $",?65,"QTY",?75,"INV $",!,%
- +12 IF 'SCREEN
- SET $Y=9
- +13 QUIT
- +14 ;
- ABBREV ;;display abbreviations
- +1 ;;TRANSACTION TYPE (TT) ABBREVIATIONS: U = USAGE
- +2 ;; R = RECEIVING A = MANUAL ADJUSTMENT
- +3 ;; D = DISTRIBUTION (REGULAR ISSUES) S = ASSEMBLE SETS
- +4 ;; C = DISTRIBUTION (CALL-IN) P = PHYSICAL COUNT
- +5 ;; E = DISTRIBUTION (EMERGENCY) Q = QTY ADJ TO SUPPLY STATION
