- PRCPRDI2 ;WISC/RFJ-print calculated due-ins ;30 Aug 91
- ;;5.1;IFCAP;;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- Q
- ;
- ;
- PRINT ; called from prcprdi1 to print calculated due-ins
- N %,%H,%I,D,DATA,DATE,DUEIN,ITEMDA,NSN,PAGE,PRCPFLAG,QTY,SCREEN,TRANDA,TRANNO,X,Y
- D NOW^%DTC S Y=% D DD^%DT S DATE=Y,PAGE=1,SCREEN=$$SCRPAUSE^PRCPUREP,ITEMDA=0 U IO D H
- ; sort by nsn
- K ^TMP($J,"PRCPRDI2")
- F S ITEMDA=$O(^TMP($J,"PRCPRDI1-DI",ITEMDA)) Q:'ITEMDA S NSN=$$NSN^PRCPUX1(ITEMDA) S:NSN="" NSN=" " S ^TMP($J,"PRCPRDI2",NSN,ITEMDA)=""
- ;
- S NSN="" F S NSN=$O(^TMP($J,"PRCPRDI2",NSN)) Q:NSN=""!($D(PRCPFLAG)) S ITEMDA=0 F S ITEMDA=$O(^TMP($J,"PRCPRDI2",NSN,ITEMDA)) Q:'ITEMDA!($D(PRCPFLAG)) D
- . I $Y>(IOSL-4) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
- . S D=$G(^PRCP(445,PRCP("I"),1,ITEMDA,0))
- . W !!,NSN,?20,$E($$DESCR^PRCPUX1(PRCP("I"),ITEMDA),1,20),?42,"[#",ITEMDA,"]",?49,$J($$UNITVAL^PRCPUX1($P(D,"^",14),$P(D,"^",5)," per "),13),?70,$J($$GETIN^PRCPUDUE(PRCP("I"),ITEMDA),10)
- . D H1
- . S (TRANDA,DUEIN)=0 F S TRANDA=$O(^TMP($J,"PRCPRDI1-DI",ITEMDA,TRANDA)) Q:'TRANDA!($D(PRCPFLAG)) S DATA=^(TRANDA) D
- . . I $Y>(IOSL-4) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H,H1
- . . S TRANNO=$P($G(^PRCS(410,TRANDA,0)),"^"),DUEIN=DUEIN+$P(DATA,"^",2)
- . . W !?10,TRANNO,?30,$P($P($G(^PRC(442,+$P(DATA,"^",6),0)),"^"),"-",2),?37,$J($$UNITVAL^PRCPUX1($P(DATA,"^",4),$P(DATA,"^",3)," per "),13),?56,$J($P(DATA,"^",5),6),$J($P(DATA,"^",2),10)
- . . I '$D(^PRCP(445,PRCP("I"),1,ITEMDA,7,TRANDA,0)) W ?77,"ADD" Q
- . . I $P(^PRCP(445,PRCP("I"),1,ITEMDA,7,TRANDA,0),"^",2)'=$P(DATA,"^",2) W ?77,"UPD"
- . ;
- . W !?33,"CALCULATED TOTAL DUE-IN QTY: ",$J(DUEIN,10) I $$GETIN^PRCPUDUE(PRCP("I"),ITEMDA)'=DUEIN W " <-----*"
- ;
- I $D(PRCPFLAG),$G(PRCPFUPD) U IO(0) W !,"DUE-INS AND OUTSTANDING TRANSACTIONS WILL NOT BE UPDATED UNTIL ENTIRE REPORT",!,"IS PRINTED."
- I '$D(PRCPFLAG),$G(PRCPFUPD) D UPDATE W !!,"DUE-INS AND OUTSTANDING TRANSACTIONS HAVE BEEN UPDATED."
- I '$D(PRCPFLAG) D END^PRCPUREP
- D ^%ZISC K ^TMP($J,"PRCPRDI2")
- Q
- ;
- ;
- H S %=DATE_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
- W $C(13),"CALCULATED DUE-INS REPORT FOR: ",PRCP("IN"),?(80-$L(%)),%,!,"NSN",?20,"DESCRIPTION",?42,"[#MI]",?51,"UNIT per ISS",?70,"DUE-IN QTY",! S %="",$P(%,"-",81)="" W %
- Q
- ;
- ;
- H1 W !?10,"TRANSACTION",?30,"PO #",?39,"UNIT per REC",?53,"CONV FACT",?66,"DUE-IN"
- Q
- ;
- ;
- UPDATE ; update due-ins and outstanding transactions
- N %,DATA,ITEMDA,TRANDA
- S ITEMDA=0 F S ITEMDA=$O(^PRCP(445,PRCP("I"),1,ITEMDA)) Q:'ITEMDA D
- . L +^PRCP(445,PRCP("I"),1,ITEMDA)
- . ; get rid of old transactions
- . S TRANDA=0 F S TRANDA=$O(^PRCP(445,PRCP("I"),1,ITEMDA,7,TRANDA)) Q:'TRANDA I $D(^TMP($J,"PRCPRDI1-CK",TRANDA)),'$D(^TMP($J,"PRCPRDI1-DI",ITEMDA,TRANDA)) D KILLTRAN^PRCPUTRA(PRCP("I"),ITEMDA,TRANDA)
- . ; add new transactions
- . S TRANDA=0 F S TRANDA=$O(^TMP($J,"PRCPRDI1-DI",ITEMDA,TRANDA)) Q:'TRANDA S DATA=^(TRANDA) D
- . . I '$D(^PRCP(445,PRCP("I"),1,ITEMDA,7,TRANDA,0)) D ADDTRAN^PRCPUTRA(PRCP("I"),ITEMDA,TRANDA,$P(DATA,"^",2,5))
- . . S %=^PRCP(445,PRCP("I"),1,ITEMDA,7,TRANDA,0),$P(%,"^",2)=$P(DATA,"^",2)
- . . I $P(DATA,"^",3) S $P(%,"^",3)=$P(DATA,"^",3)
- . . I $P(DATA,"^",4) S $P(%,"^",4)=$P(DATA,"^",4)
- . . I $P(DATA,"^",5) S $P(%,"^",5)=$P(DATA,"^",5)
- . . S ^PRCP(445,PRCP("I"),1,ITEMDA,7,TRANDA,0)=%
- . ; recalc total quantity due-in
- . S QTY=0
- . S TRANDA=0 F S TRANDA=$O(^PRCP(445,PRCP("I"),1,ITEMDA,7,TRANDA)) Q:'TRANDA S QTY=QTY+$P($G(^(TRANDA,0)),"^",2)
- . I QTY<0 S QTY=0
- . D SETIN^PRCPUDUE(PRCP("I"),ITEMDA,QTY-$$GETIN^PRCPUDUE(PRCP("I"),ITEMDA))
- . L -^PRCP(445,PRCP("I"),1,ITEMDA)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPRDI2 3792 printed Feb 18, 2025@23:41:10 Page 2
- PRCPRDI2 ;WISC/RFJ-print calculated due-ins ;30 Aug 91
- +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 ; called from prcprdi1 to print calculated due-ins
- +1 NEW %,%H,%I,D,DATA,DATE,DUEIN,ITEMDA,NSN,PAGE,PRCPFLAG,QTY,SCREEN,TRANDA,TRANNO,X,Y
- +2 DO NOW^%DTC
- SET Y=%
- DO DD^%DT
- SET DATE=Y
- SET PAGE=1
- SET SCREEN=$$SCRPAUSE^PRCPUREP
- SET ITEMDA=0
- USE IO
- DO H
- +3 ; sort by nsn
- +4 KILL ^TMP($JOB,"PRCPRDI2")
- +5 FOR
- SET ITEMDA=$ORDER(^TMP($JOB,"PRCPRDI1-DI",ITEMDA))
- if 'ITEMDA
- QUIT
- SET NSN=$$NSN^PRCPUX1(ITEMDA)
- if NSN=""
- SET NSN=" "
- SET ^TMP($JOB,"PRCPRDI2",NSN,ITEMDA)=""
- +6 ;
- +7 SET NSN=""
- FOR
- SET NSN=$ORDER(^TMP($JOB,"PRCPRDI2",NSN))
- if NSN=""!($DATA(PRCPFLAG))
- QUIT
- SET ITEMDA=0
- FOR
- SET ITEMDA=$ORDER(^TMP($JOB,"PRCPRDI2",NSN,ITEMDA))
- if 'ITEMDA!($DATA(PRCPFLAG))
- QUIT
- Begin DoDot:1
- +8 IF $Y>(IOSL-4)
- if SCREEN
- DO P^PRCPUREP
- if $DATA(PRCPFLAG)
- QUIT
- DO H
- +9 SET D=$GET(^PRCP(445,PRCP("I"),1,ITEMDA,0))
- +10 WRITE !!,NSN,?20,$EXTRACT($$DESCR^PRCPUX1(PRCP("I"),ITEMDA),1,20),?42,"[#",ITEMDA,"]",?49,$JUSTIFY($$UNITVAL^PRCPUX1($PIECE(D,"^",14),$PIECE(D,"^",5)," per "),13),?70,$JUSTIFY($$GETIN^PRCPUDUE(PRCP("I"),ITEMDA),10)
- +11 DO H1
- +12 SET (TRANDA,DUEIN)=0
- FOR
- SET TRANDA=$ORDER(^TMP($JOB,"PRCPRDI1-DI",ITEMDA,TRANDA))
- if 'TRANDA!($DATA(PRCPFLAG))
- QUIT
- SET DATA=^(TRANDA)
- Begin DoDot:2
- +13 IF $Y>(IOSL-4)
- if SCREEN
- DO P^PRCPUREP
- if $DATA(PRCPFLAG)
- QUIT
- DO H
- DO H1
- +14 SET TRANNO=$PIECE($GET(^PRCS(410,TRANDA,0)),"^")
- SET DUEIN=DUEIN+$PIECE(DATA,"^",2)
- +15 WRITE !?10,TRANNO,?30,$PIECE($PIECE($GET(^PRC(442,+$PIECE(DATA,"^",6),0)),"^"),"-",2),?37,$JUSTIFY($$UNITVAL^PRCPUX1($PIECE(DATA,"^",4),$PIECE(DATA,"^",3)," per "),13),?56,$JUSTIFY($PIECE(DATA,"^",5),6),$JUSTIFY($PIECE(DATA,
- "^",2),10)
- +16 IF '$DATA(^PRCP(445,PRCP("I"),1,ITEMDA,7,TRANDA,0))
- WRITE ?77,"ADD"
- QUIT
- +17 IF $PIECE(^PRCP(445,PRCP("I"),1,ITEMDA,7,TRANDA,0),"^",2)'=$PIECE(DATA,"^",2)
- WRITE ?77,"UPD"
- End DoDot:2
- +18 ;
- +19 WRITE !?33,"CALCULATED TOTAL DUE-IN QTY: ",$JUSTIFY(DUEIN,10)
- IF $$GETIN^PRCPUDUE(PRCP("I"),ITEMDA)'=DUEIN
- WRITE " <-----*"
- End DoDot:1
- +20 ;
- +21 IF $DATA(PRCPFLAG)
- IF $GET(PRCPFUPD)
- USE IO(0)
- WRITE !,"DUE-INS AND OUTSTANDING TRANSACTIONS WILL NOT BE UPDATED UNTIL ENTIRE REPORT",!,"IS PRINTED."
- +22 IF '$DATA(PRCPFLAG)
- IF $GET(PRCPFUPD)
- DO UPDATE
- WRITE !!,"DUE-INS AND OUTSTANDING TRANSACTIONS HAVE BEEN UPDATED."
- +23 IF '$DATA(PRCPFLAG)
- DO END^PRCPUREP
- +24 DO ^%ZISC
- KILL ^TMP($JOB,"PRCPRDI2")
- +25 QUIT
- +26 ;
- +27 ;
- H SET %=DATE_" PAGE "_PAGE
- SET PAGE=PAGE+1
- IF PAGE'=2!(SCREEN)
- WRITE @IOF
- +1 WRITE $CHAR(13),"CALCULATED DUE-INS REPORT FOR: ",PRCP("IN"),?(80-$LENGTH(%)),%,!,"NSN",?20,"DESCRIPTION",?42,"[#MI]",?51,"UNIT per ISS",?70,"DUE-IN QTY",!
- SET %=""
- SET $PIECE(%,"-",81)=""
- WRITE %
- +2 QUIT
- +3 ;
- +4 ;
- H1 WRITE !?10,"TRANSACTION",?30,"PO #",?39,"UNIT per REC",?53,"CONV FACT",?66,"DUE-IN"
- +1 QUIT
- +2 ;
- +3 ;
- UPDATE ; update due-ins and outstanding transactions
- +1 NEW %,DATA,ITEMDA,TRANDA
- +2 SET ITEMDA=0
- FOR
- SET ITEMDA=$ORDER(^PRCP(445,PRCP("I"),1,ITEMDA))
- if 'ITEMDA
- QUIT
- Begin DoDot:1
- +3 LOCK +^PRCP(445,PRCP("I"),1,ITEMDA)
- +4 ; get rid of old transactions
- +5 SET TRANDA=0
- FOR
- SET TRANDA=$ORDER(^PRCP(445,PRCP("I"),1,ITEMDA,7,TRANDA))
- if 'TRANDA
- QUIT
- IF $DATA(^TMP($JOB,"PRCPRDI1-CK",TRANDA))
- IF '$DATA(^TMP($JOB,"PRCPRDI1-DI",ITEMDA,TRANDA))
- DO KILLTRAN^PRCPUTRA(PRCP("I"),ITEMDA,TRANDA)
- +6 ; add new transactions
- +7 SET TRANDA=0
- FOR
- SET TRANDA=$ORDER(^TMP($JOB,"PRCPRDI1-DI",ITEMDA,TRANDA))
- if 'TRANDA
- QUIT
- SET DATA=^(TRANDA)
- Begin DoDot:2
- +8 IF '$DATA(^PRCP(445,PRCP("I"),1,ITEMDA,7,TRANDA,0))
- DO ADDTRAN^PRCPUTRA(PRCP("I"),ITEMDA,TRANDA,$PIECE(DATA,"^",2,5))
- +9 SET %=^PRCP(445,PRCP("I"),1,ITEMDA,7,TRANDA,0)
- SET $PIECE(%,"^",2)=$PIECE(DATA,"^",2)
- +10 IF $PIECE(DATA,"^",3)
- SET $PIECE(%,"^",3)=$PIECE(DATA,"^",3)
- +11 IF $PIECE(DATA,"^",4)
- SET $PIECE(%,"^",4)=$PIECE(DATA,"^",4)
- +12 IF $PIECE(DATA,"^",5)
- SET $PIECE(%,"^",5)=$PIECE(DATA,"^",5)
- +13 SET ^PRCP(445,PRCP("I"),1,ITEMDA,7,TRANDA,0)=%
- End DoDot:2
- +14 ; recalc total quantity due-in
- +15 SET QTY=0
- +16 SET TRANDA=0
- FOR
- SET TRANDA=$ORDER(^PRCP(445,PRCP("I"),1,ITEMDA,7,TRANDA))
- if 'TRANDA
- QUIT
- SET QTY=QTY+$PIECE($GET(^(TRANDA,0)),"^",2)
- +17 IF QTY<0
- SET QTY=0
- +18 DO SETIN^PRCPUDUE(PRCP("I"),ITEMDA,QTY-$$GETIN^PRCPUDUE(PRCP("I"),ITEMDA))
- +19 LOCK -^PRCP(445,PRCP("I"),1,ITEMDA)
- End DoDot:1
- +20 QUIT