source: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPEIL0.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.5 KB
Line 
1PRCPEIL0 ;WISC/RFJ-edit inventory items (build arrays) ; 9/20/06 11:02am
2 ;;5.1;IFCAP;**98**;Oct 20, 2000;Build 37
3 ;Per VHA Directive 2004-038, this routine should not be modified.
4 Q
5 ;
6 ;
7ISSUNITS ; build issue units array
8 S LINE=9,COLUMN=1,CLREND=39
9 D SET("Issue Units ",LINE,COLUMN,CLREND,0,IORVON,IORVOFF)
10 D SET("Unit per Issue: "_$$UNIT^PRCPUX1(PRCPINPT,ITEMDA," per "),LINE+1,COLUMN,CLREND)
11 I PRCPTYPE="P" D SET("Issue Multiple",LINE+2,COLUMN,CLREND,16)
12 I PRCPTYPE="P" D SET("Min Issue Qty ",LINE+3,COLUMN,CLREND,16.5)
13 Q
14 ;
15 ;
16COSTS ; build costs array
17 S LINE=16,COLUMN=40,CLREND=80
18 D SET("Costing Data",LINE+0,COLUMN,CLREND,0,IORVON,IORVOFF)
19 D SET("Last Cost ",LINE+1,COLUMN,CLREND,4.7)
20 D SET("Average Cost",LINE+2,COLUMN,CLREND,4.8)
21 D SET("Total Value ",LINE+3,COLUMN,CLREND,4.81)
22 Q
23 ;
24 ;
25LEVELS ; build levels array
26 S LINE=9,COLUMN=40,CLREND=80
27 D SET("Levels ",LINE+0,COLUMN,CLREND,0,IORVON,IORVOFF)
28 D SET("Norm Stock Level",LINE+1,COLUMN,CLREND,9)
29 D SET("Emer Stock Level",LINE+2,COLUMN,CLREND,11)
30 D SET("Temp Stock Level",LINE+3,COLUMN,CLREND,9.5)
31 D SET("Delete Temp SL ",LINE+4,COLUMN,CLREND,9.6)
32 D SET("Stand Reord Pt ",LINE+5,COLUMN,CLREND,10)
33 D SET("Option Reord Pt ",LINE+6,COLUMN,CLREND,10.3)
34 Q
35 ;
36 ;
37QUANTITY ; build quantities array
38 S LINE=16,COLUMN=1,CLREND=39
39 D SET("Quantities ",LINE+0,COLUMN,CLREND,0,IORVON,IORVOFF)
40 D SET("On-hand ",LINE+1,COLUMN,CLREND,7)
41 D SET("Due-In ",LINE+2,COLUMN,CLREND,8.1)
42 D SET("Due-Out ",LINE+3,COLUMN,CLREND,8.6)
43 D SET($S(PRCPTYPE="W":"Non-Issuable",1:""),LINE+4,COLUMN,CLREND,$S(PRCPTYPE="W":7.5,1:0))
44 D SET("",LINE+5,COLUMN,80)
45 Q
46 ;
47 ;
48OUTSTRAN ; build outstanding transaction array
49 N D,PRCPDA
50 S LINE=22,COLUMN=1,CLREND=80
51 D SET("Due-Ins/Outstanding Transactions",LINE+0,COLUMN,CLREND,0,IORVON,IORVOFF)
52 S PRCPDA=0 F LINE=23:1:29 S PRCPDA=$O(^PRCP(445,PRCPINPT,1,ITEMDA,7,PRCPDA)) Q:'PRCPDA S X=$G(^(+PRCPDA,0)) D
53 . I X="" D SET("",LINE,COLUMN,CLREND) Q
54 . S D=$E($P($G(^PRCS(410,+$P(X,"^"),0)),"^")_$J("",34),1,34)_" Qty: "_$E($P(X,"^",2)_$J("",8),1,8)_" U/R: "_$E($$UNITVAL^PRCPUX1($P(X,"^",4),$P(X,"^",3),"/")_$J("",10),1,10)_" CF: "_$P(X,"^",5)
55 . D SET(D,LINE,COLUMN,CLREND)
56 F LINE=LINE:1:29 D SET("",LINE,COLUMN,CLREND)
57 S PRCPDA=$O(^PRCP(445,PRCPINPT,1,ITEMDA,7,PRCPDA))
58 D SET($S('PRCPDA:"",1:" . . . more . . . (only first 7 displayed)"),LINE+1,COLUMN,CLREND)
59 Q
60 ;
61 ;
62SPECIAL ; build special parameter array
63 ; subroutine modified to add On-Demand Items (PRC*5.1*98)
64 N PRCPONN S PRCPONN=""
65 S LINE=31,COLUMN=1,CLREND=39
66 D SET("Special Parameters",LINE+0,COLUMN,CLREND,0,IORVON,IORVOFF)
67 D SET("Kill When Zero ",LINE+1,COLUMN,CLREND,17)
68 D SET("",LINE+2,COLUMN,CLREND)
69 S X=""
70 I PRCPTYPE="W" S X="",%=0 F S %=$O(^PRCP(445,PRCPINPT,1,ITEMDA,4,%)) Q:'% S X=X_$S(X="":"",1:", ")_%
71 I PRCPTYPE'="W" D
72 . N X
73 . S X=$$GET1^DIQ(445.01,ITEMDA_","_PRCPINPT_",",.8,"E")
74 . I X']"" S X="NO"
75 . S PRCPONN="On-Demand : "
76 . I '$O(^PRCP(445,PRCPINPT,9,"B",DUZ,"")) S PRCPONN="(On-Demand) : "
77 . S PRCPONN=PRCPONN_X
78 D SET($S(PRCPTYPE="W":"Substitute Items: "_X,1:PRCPONN),LINE+3,COLUMN,CLREND)
79 D SET("",LINE+4,COLUMN,CLREND)
80 Q
81 ;
82 ;
83DRUGACCT ; build drug accountability array
84 S LINE=31,COLUMN=40,CLREND=80
85 D SET("Drug Accountability ",LINE+0,COLUMN,CLREND,0,IORVON,IORVOFF)
86 D SET("Dispensing Unit ",LINE+1,COLUMN,CLREND,50)
87 D SET("Dispensing Unit Conv Fact",LINE+2,COLUMN,CLREND,51)
88 Q
89 ;
90 ;
91SOURCES ; build sources array
92 N D,PRCPDA
93 S LINE=36,COLUMN=1,CLREND=80
94 D SET("Procurement Sources",LINE+0,COLUMN,CLREND,0,IORVON,IORVOFF)
95 D SET("Mandatory Source ",LINE+0,37,CLREND,.4)
96 S PRCPDA=0 F LINE=37:1:44 S PRCPDA=$O(^PRCP(445,PRCPINPT,1,ITEMDA,5,PRCPDA)) Q:'PRCPDA S X=$G(^(+PRCPDA,0)) D
97 . I X="" D SET("",LINE,COLUMN,CLREND) Q
98 . S D=$E($$VENNAME^PRCPUX1($P(X,"^"))_$J("",34),1,34)_" U/R: "_$E($$UNITVAL^PRCPUX1($P(X,"^",3),$P(X,"^",2),"/")_$J("",10),1,10)_" CF: "_$P(X,"^",4)
99 . D SET(D,LINE,COLUMN,CLREND)
100 F LINE=LINE:1:44 D SET("",LINE,COLUMN,CLREND)
101 S PRCPDA=$O(^PRCP(445,PRCPINPT,1,ITEMDA,5,PRCPDA))
102 D SET($S('PRCPDA:"",1:" . . . more . . . (only first 8 displayed)"),LINE+1,COLUMN,CLREND)
103 Q
104 ;
105 ;
106SET(STRING,LINE,COLUMN,CLREND,FIELD,ON,OFF) ; set array
107 I $G(FIELD) S STRING=STRING_": "_$G(PRCPDATA(445.01,ITEMDA,FIELD,"E"))
108 I STRING="" D SET^VALM10(LINE,$J("",80)) Q
109 I '$D(@VALMAR@(LINE,0)) D SET^VALM10(LINE,$J("",80))
110 D SET^VALM10(LINE,$$SETSTR^VALM1(STRING,@VALMAR@(LINE,0),COLUMN,CLREND))
111 I $G(ON)]""!($G(OFF)]"") D CNTRL^VALM10(LINE,COLUMN,$L(STRING),ON,OFF)
112 Q
Note: See TracBrowser for help on using the repository browser.