source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPRCFR.m@ 1093

Last change on this file since 1093 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.8 KB
RevLine 
[613]1PRCPRCFR ;WISC/RFJ-conversion factor report (option, whse) ;09 Jun 93
2 ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 D ^PRCPUSEL Q:'$G(PRCP("I"))
5 I PRCP("DPTYPE")'="W" D PRIMARY^PRCPRCFP Q
6 ;
7 ; conversion factor report for whse
8 N PRCPEND,PRCPSTRT,X
9 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."
10 D DISPLAY^PRCPUX2(40,79,.X)
11 K X S X(1)="Select the range of NSNs to display" D DISPLAY^PRCPUX2(2,40,.X)
12 D NSNSEL^PRCPURS0 I '$D(PRCPSTRT) Q
13 W ! S %ZIS="Q" D ^%ZIS Q:POP I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK Q
14 . S ZTDESC="Conversion Factor Report",ZTRTN="DQ^PRCPRCFR"
15 . S ZTSAVE("PRCP*")="",ZTSAVE("ZTREQ")="@"
16 W !!,"<*> please wait <*>"
17DQ ; queue starts here
18 N %,%H,%I,ITEMDA,ITEMDATA,NOW,NSN,PAGE,PRCPFLAG,SCREEN,VENDATA,VENNM,X,Y
19 K ^TMP($J,"PRCPRCFR")
20 S ITEMDA=0 F S ITEMDA=$O(^PRCP(445,PRCP("I"),1,ITEMDA)) Q:'ITEMDA D
21 . S NSN=$$NSN^PRCPUX1(ITEMDA) S:NSN="" NSN=" "
22 . I $E(NSN,1,$L(PRCPSTRT))'=PRCPSTRT,$E(NSN,1,$L(PRCPEND))'=PRCPEND I NSN']PRCPSTRT!(PRCPEND']NSN) Q
23 . 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
24 . . S VENNM=$$VENNAME^PRCPUX1($P(VENDATA,"^")) S:VENNM="" VENNM=" "
25 . . S ^TMP($J,"PRCPRCFR",NSN,ITEMDA,$E(VENNM,1,18))=VENDATA
26 ; print report
27 D NOW^%DTC S Y=% D DD^%DT S NOW=Y,PAGE=1,SCREEN=$$SCRPAUSE^PRCPUREP U IO D H
28 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
29 . I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
30 . S ITEMDATA=$G(^PRCP(445,PRCP("I"),1,ITEMDA,0))
31 . 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)
32 . S VENNM="" F S VENNM=$O(^TMP($J,"PRCPRCFR",NSN,ITEMDA,VENNM)) Q:VENNM=""!($G(PRCPFLAG)) S VENDATA=^(VENNM) D
33 . . I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
34 . . S %=$S($P(VENDATA,"^")["PRCP(445":"I#",1:"V#")_+VENDATA
35 . . W !?33,VENNM,?53,%,?61,$J($$UNITVAL^PRCPUX1($P(VENDATA,"^",3),$P(VENDATA,"^",2),"/"),10),$J($P(VENDATA,"^",4),9)
36 . I $G(ZTQUEUED),$$S^%ZTLOAD S PRCPFLAG=1 W !?10,"<<< TASKMANAGER JOB TERMINATED BY USER >>>"
37 I '$G(PRCPFLAG) D END^PRCPUREP
38 D ^%ZISC K ^TMP($J,"PRCPRCFR")
39 Q
40 ;
41H S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
42 W $C(13),"CONVERSION FACTOR REPORT FOR: ",$E(PRCP("IN"),1,20),?(80-$L(%)),%
43 S %="",$P(%,"-",81)=""
44 W !,"NSN",?15,"DESCRIPTION",?46,"MI",$J("QTY OH",13),$J("UNIT/IS",10)
45 W !?33,"PROCUREMENT SOURCE",?54,"IV#",?61,$J("UNIT/RE",10),$J("CF",9),!,%
46 Q
Note: See TracBrowser for help on using the repository browser.