- 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 Feb 18, 2025@23:41:01 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