PRCPRCFR ;WISC/RFJ-conversion factor report (option, whse) ;09 Jun 93
;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
D ^PRCPUSEL Q:'$G(PRCP("I"))
I PRCP("DPTYPE")'="W" D PRIMARY^PRCPRCFP Q
;
; conversion factor report for whse
N PRCPEND,PRCPSTRT,X
K X S X(1)="The Conversion Factor Report will display the inventory point items with procurement sources and conversion factors. This report will sort the Warehouse inventory items by the NSN and the procurement source."
D DISPLAY^PRCPUX2(40,79,.X)
K X S X(1)="Select the range of NSNs to display" D DISPLAY^PRCPUX2(2,40,.X)
D NSNSEL^PRCPURS0 I '$D(PRCPSTRT) Q
W ! S %ZIS="Q" D ^%ZIS Q:POP I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK Q
. S ZTDESC="Conversion Factor Report",ZTRTN="DQ^PRCPRCFR"
. S ZTSAVE("PRCP*")="",ZTSAVE("ZTREQ")="@"
W !!,"<*> please wait <*>"
DQ ; queue starts here
N %,%H,%I,ITEMDA,ITEMDATA,NOW,NSN,PAGE,PRCPFLAG,SCREEN,VENDATA,VENNM,X,Y
K ^TMP($J,"PRCPRCFR")
S ITEMDA=0 F S ITEMDA=$O(^PRCP(445,PRCP("I"),1,ITEMDA)) Q:'ITEMDA D
. S NSN=$$NSN^PRCPUX1(ITEMDA) S:NSN="" NSN=" "
. I $E(NSN,1,$L(PRCPSTRT))'=PRCPSTRT,$E(NSN,1,$L(PRCPEND))'=PRCPEND I NSN']PRCPSTRT!(PRCPEND']NSN) Q
. S X=0 F S X=$O(^PRCP(445,PRCP("I"),1,ITEMDA,5,X)) Q:'X S VENDATA=$G(^(X,0)) I VENDATA'="" D
. . S VENNM=$$VENNAME^PRCPUX1($P(VENDATA,"^")) S:VENNM="" VENNM=" "
. . S ^TMP($J,"PRCPRCFR",NSN,ITEMDA,$E(VENNM,1,18))=VENDATA
; print report
D NOW^%DTC S Y=% D DD^%DT S NOW=Y,PAGE=1,SCREEN=$$SCRPAUSE^PRCPUREP U IO D H
S NSN="" F S NSN=$O(^TMP($J,"PRCPRCFR",NSN)) Q:NSN=""!($G(PRCPFLAG)) S ITEMDA=0 F S ITEMDA=$O(^TMP($J,"PRCPRCFR",NSN,ITEMDA)) Q:'ITEMDA!($G(PRCPFLAG)) D
. I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
. S ITEMDATA=$G(^PRCP(445,PRCP("I"),1,ITEMDA,0))
. W !,$TR(NSN,"-"),?15,$E($$DESCR^PRCPUX1(PRCP("I"),ITEMDA),1,30),?46,ITEMDA,?53,$J(+$P(ITEMDATA,"^",7),8),$J($$UNIT^PRCPUX1(PRCP("I"),ITEMDA,"/"),10)
. S VENNM="" F S VENNM=$O(^TMP($J,"PRCPRCFR",NSN,ITEMDA,VENNM)) Q:VENNM=""!($G(PRCPFLAG)) S VENDATA=^(VENNM) D
. . I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
. . S %=$S($P(VENDATA,"^")["PRCP(445":"I#",1:"V#")_+VENDATA
. . W !?33,VENNM,?53,%,?61,$J($$UNITVAL^PRCPUX1($P(VENDATA,"^",3),$P(VENDATA,"^",2),"/"),10),$J($P(VENDATA,"^",4),9)
. I $G(ZTQUEUED),$$S^%ZTLOAD S PRCPFLAG=1 W !?10,"<<< TASKMANAGER JOB TERMINATED BY USER >>>"
I '$G(PRCPFLAG) D END^PRCPUREP
D ^%ZISC K ^TMP($J,"PRCPRCFR")
Q
;
H S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
W $C(13),"CONVERSION FACTOR REPORT FOR: ",$E(PRCP("IN"),1,20),?(80-$L(%)),%
S %="",$P(%,"-",81)=""
W !,"NSN",?15,"DESCRIPTION",?46,"MI",$J("QTY OH",13),$J("UNIT/IS",10)
W !?33,"PROCUREMENT SOURCE",?54,"IV#",?61,$J("UNIT/RE",10),$J("CF",9),!,%
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPRCFR 2881 printed Dec 13, 2024@02:14:39 Page 2
PRCPRCFR ;WISC/RFJ-conversion factor report (option, whse) ;09 Jun 93
+1 ;;5.1;IFCAP;;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 DO ^PRCPUSEL
if '$GET(PRCP("I"))
QUIT
+4 IF PRCP("DPTYPE")'="W"
DO PRIMARY^PRCPRCFP
QUIT
+5 ;
+6 ; conversion factor report for whse
+7 NEW PRCPEND,PRCPSTRT,X
+8 KILL X
SET X(1)="The Conversion Factor Report will display the inventory point items with procurement sources and conversion factors. This report will sort the Warehouse inventory items by the NSN and the procurement source."
+9 DO DISPLAY^PRCPUX2(40,79,.X)
+10 KILL X
SET X(1)="Select the range of NSNs to display"
DO DISPLAY^PRCPUX2(2,40,.X)
+11 DO NSNSEL^PRCPURS0
IF '$DATA(PRCPSTRT)
QUIT
+12 WRITE !
SET %ZIS="Q"
DO ^%ZIS
if POP
QUIT
IF $DATA(IO("Q"))
Begin DoDot:1
+13 SET ZTDESC="Conversion Factor Report"
SET ZTRTN="DQ^PRCPRCFR"
+14 SET ZTSAVE("PRCP*")=""
SET ZTSAVE("ZTREQ")="@"
End DoDot:1
DO ^%ZTLOAD
KILL IO("Q"),ZTSK
QUIT
+15 WRITE !!,"<*> please wait <*>"
DQ ; queue starts here
+1 NEW %,%H,%I,ITEMDA,ITEMDATA,NOW,NSN,PAGE,PRCPFLAG,SCREEN,VENDATA,VENNM,X,Y
+2 KILL ^TMP($JOB,"PRCPRCFR")
+3 SET ITEMDA=0
FOR
SET ITEMDA=$ORDER(^PRCP(445,PRCP("I"),1,ITEMDA))
if 'ITEMDA
QUIT
Begin DoDot:1
+4 SET NSN=$$NSN^PRCPUX1(ITEMDA)
if NSN=""
SET NSN=" "
+5 IF $EXTRACT(NSN,1,$LENGTH(PRCPSTRT))'=PRCPSTRT
IF $EXTRACT(NSN,1,$LENGTH(PRCPEND))'=PRCPEND
IF NSN']PRCPSTRT!(PRCPEND']NSN)
QUIT
+6 SET X=0
FOR
SET X=$ORDER(^PRCP(445,PRCP("I"),1,ITEMDA,5,X))
if 'X
QUIT
SET VENDATA=$GET(^(X,0))
IF VENDATA'=""
Begin DoDot:2
+7 SET VENNM=$$VENNAME^PRCPUX1($PIECE(VENDATA,"^"))
if VENNM=""
SET VENNM=" "
+8 SET ^TMP($JOB,"PRCPRCFR",NSN,ITEMDA,$EXTRACT(VENNM,1,18))=VENDATA
End DoDot:2
End DoDot:1
+9 ; print report
+10 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET NOW=Y
SET PAGE=1
SET SCREEN=$$SCRPAUSE^PRCPUREP
USE IO
DO H
+11 SET NSN=""
FOR
SET NSN=$ORDER(^TMP($JOB,"PRCPRCFR",NSN))
if NSN=""!($GET(PRCPFLAG))
QUIT
SET ITEMDA=0
FOR
SET ITEMDA=$ORDER(^TMP($JOB,"PRCPRCFR",NSN,ITEMDA))
if 'ITEMDA!($GET(PRCPFLAG))
QUIT
Begin DoDot:1
+12 IF $Y>(IOSL-6)
if SCREEN
DO P^PRCPUREP
if $DATA(PRCPFLAG)
QUIT
DO H
+13 SET ITEMDATA=$GET(^PRCP(445,PRCP("I"),1,ITEMDA,0))
+14 WRITE !,$TRANSLATE(NSN,"-"),?15,$EXTRACT($$DESCR^PRCPUX1(PRCP("I"),ITEMDA),1,30),?46,ITEMDA,?53,$JUSTIFY(+$PIECE(ITEMDATA,"^",7),8),$JUSTIFY($$UNIT^PRCPUX1(PRCP("I"),ITEMDA,"/"),10)
+15 SET VENNM=""
FOR
SET VENNM=$ORDER(^TMP($JOB,"PRCPRCFR",NSN,ITEMDA,VENNM))
if VENNM=""!($GET(PRCPFLAG))
QUIT
SET VENDATA=^(VENNM)
Begin DoDot:2
+16 IF $Y>(IOSL-6)
if SCREEN
DO P^PRCPUREP
if $DATA(PRCPFLAG)
QUIT
DO H
+17 SET %=$SELECT($PIECE(VENDATA,"^")["PRCP(445":"I#",1:"V#")_+VENDATA
+18 WRITE !?33,VENNM,?53,%,?61,$JUSTIFY($$UNITVAL^PRCPUX1($PIECE(VENDATA,"^",3),$PIECE(VENDATA,"^",2),"/"),10),$JUSTIFY($PIECE(VENDATA,"^",4),9)
End DoDot:2
+19 IF $GET(ZTQUEUED)
IF $$S^%ZTLOAD
SET PRCPFLAG=1
WRITE !?10,"<<< TASKMANAGER JOB TERMINATED BY USER >>>"
End DoDot:1
+20 IF '$GET(PRCPFLAG)
DO END^PRCPUREP
+21 DO ^%ZISC
KILL ^TMP($JOB,"PRCPRCFR")
+22 QUIT
+23 ;
H SET %=NOW_" PAGE "_PAGE
SET PAGE=PAGE+1
IF PAGE'=2!(SCREEN)
WRITE @IOF
+1 WRITE $CHAR(13),"CONVERSION FACTOR REPORT FOR: ",$EXTRACT(PRCP("IN"),1,20),?(80-$LENGTH(%)),%
+2 SET %=""
SET $PIECE(%,"-",81)=""
+3 WRITE !,"NSN",?15,"DESCRIPTION",?46,"MI",$JUSTIFY("QTY OH",13),$JUSTIFY("UNIT/IS",10)
+4 WRITE !?33,"PROCUREMENT SOURCE",?54,"IV#",?61,$JUSTIFY("UNIT/RE",10),$JUSTIFY("CF",9),!,%
+5 QUIT
