close Warning: Can't use blame annotator: 
svn blame failed on WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCSES.m: 'GenericSWIGWrapper' object has no attribute '_wrap'

source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCSES.m@ 1464

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

initial load of WorldVistAEHR
File size: 5.3 KB
RevLine 
1PRCSES ;WISC/SAW-SUB-MODULES CALLED BY FIELDS IN CONTROL POINT ACT. FILE ;1/20/98 3:07 PM [7/14/98 3:04pm]
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 W !,"Major budget object code classifications are:"
5 W !,"10 thru 13 - Personal Services and Benefits"
6 W !," 21 - Travel and Transportation of Persons"
7 W !," 22 - Transportation of Things"
8 W !," 23 - Rent, Communications, and Utilities"
9 W !," 24 - Printing and Reproduction"
10 W !," 25 - Other Services"
11 W !," 26 - Supplies and Materials"
12 W !,"31 thru 33 - Acquisition of Capital Assets",!
13 Q
14SUB ;INPUT TRANSFORM FOR BOC FIELD
15 S Z0=$S($D(^PRCS(410,DA(1),3)):+$P(^(3),"^",3),1:0)
16SUB1 I 'Z0!('$D(^PRCD(420.1,Z0,1,0))) K Z0,X Q
17 S DIC="^PRCD(420.1,Z0,1,",DIC(0)="EMQZ" D ^DIC I +Y'>0 K DIC,X,Z0 Q
18 S X=+$P(Y(0),"^") I '$D(^PRCD(420.2,X,0)) K DIC,X,Z0 Q
19 S (PRCS("SUB"),X)=$E($P(^PRCD(420.2,X,0),"^"),1,30) K DIC,Z0 Q
20 ;
21VENDOR ;INPUT TRANSFORM FOR VENDOR FIELD
22 ;
23 N IEN,LOOP,OK,PRCX,PRCY,NAME,N9,RV,RVX
24 K:X[""""!($A(X)=45)!($L(X)>30)!($L(X)<1)!((X?1P.E&'((X?1"`"1.N)!(X?1"**".E)))) X
25 W:'$D(X) !,$C(7),"The vendor name must be between 1 and 30 characters long,",!,"without a leading punctuation mark."
26 Q:'$D(X)
27 I $P(^PRCS(410,DA,0),"^",4)=5 D ISS Q:'$D(X) G VENDOR2
28 S PRCX=X
29AGAIN I $G(RV)>0 S NAME=$P($G(^PRC(440,RV,0)),U)
30 I $G(RV)'>0 S X=PRCX
31 S Z("Z")=1
32 I $P(^PRCS(410,DA,0),"^",4)=3,$D(^(10)),$P(^(10),"^") D K X Q
33 . W !,$C(7),"This is a repetitive item type of request."
34 . W !,"Cancel this request if you wish to order from a different vendor."
35 . Q
36 K DIC
37 K Y
38 K Y(0)
39 S Z(1)=$G(X)
40 S DIC="^PRC(440,"
41 S DIC(0)=$S($G(RV)>0:"EMQZ",1:"EMZ")
42 S:$G(RV)>0 X="`"_RV
43 S DIC("S")="I '$D(^PRC(440,""AC"",""S"",+Y))"
44 D ^DIC
45 ;
46 ; QUIT IF USER TIMES OUT OR '^'s OUT.
47 ;
48 I $D(DTOUT)!($D(DUOUT)) S X="^" Q
49 ;
50 K:Y<0 X,RV
51 S IEN=Y
52 S PRCY(0)=$G(Y(0))
53 K:+IEN>0 OK,RV
54 D:+IEN>0 INACT
55 ;
56 ; ACTIVE VENDOR
57 ;
58 I $G(OK)=1 G VENDOR2
59 ;
60 ; INACTIVE VENDOR WITH REPLACEMENT VENDOR
61 ;
62 I $G(LOOP)=1!($G(RV)>0) K X,IEN,PRCY(0),DIC G AGAIN
63 ;
64 ; NO VENDOR SELECTED
65 ;
66 I +IEN'>0 D
67 . S X=Z(1)
68 . K Z(1)
69 . I $D(^PRCS(410,DA,3)),$P(^(3),U,4)'="" S $P(^(3),"^",4)=""
70 . Q
71 ;
72 ; INACTIVE VENDOR WOTHOUT A REPLACEMENT VENDOR
73 ;
74 I $G(RV)=0 D Q
75 . K X
76 . K Z(1)
77 . I $D(^PRCS(410,DA,3)),$P(^(3),U,4)'="" S $P(^(3),"^",4)=""
78 . Q
79 ;
80VENDOR1 I +IEN'>0 W !,"INVALID SELECTION OR NOT IN VENDOR FILE. ARE YOU SURE",$C(7) S %=2 D YN^DICN G VENDOR1:%=0 K:%'=1 X W:%=1 !!,"Enter information for new vendor"
81 ;
82VENDOR2 I +IEN>0 D
83 . S Z(1)="@1"
84 . S X=$P(PRCY(0),U)
85 . S ^PRCS(410,DA,2)=$P(PRCY(0),U,1,10)
86 . S $P(^PRCS(410,DA,3),"^",4)=+IEN
87 . Q
88 K %
89 K DIC
90 Q
91 ;
92ISS S IEN=$O(^PRC(440,"AC","S",0))
93 S PRCY(0)=$S($D(^PRC(440,+IEN,0)):^(0),1:"")
94 S X=$P(PRCY(0),"^")
95 I 'IEN!(PRCY(0)="") D K X Q
96 . W $C(7),"A&MM MUST enter the A&MM Warehouse as a vendor before you can place an"
97 . W !,"Issue Book request."
98 . Q
99 W !,"Issue Book Requests will automatically be ordered from",!,X,!
100 Q
101 ;
102INACT ; CHECK IF THE VENDOR SELECTED IS INACTIVE.
103 ; IF INACTIVE, SEE IF THERE IS A REPLACEMENT VENDOR.
104 ; IF THERE IS AN ACTIVE REPLACEMENT VENDOR SUGGEST THAT VENDOR
105 ; TO THE USER.
106 ;
107 ; VARIABLES 'OK' AND 'RV' ARE UNDEFINED WHEN ENTERING 'INACT'.
108 ;
109 ; DIFFERENT OUTCOMES FROM INACT, AND OUTPUT VARIABLES.
110 ;
111 ; CONDITION OUTPUT
112 ; VENDOR SELECTED BY USER IS ACTIVE. 'OK' SET TO 1
113 ; VENDOR SELECTED BY USER IS INACTIVE,
114 ; NO REPLACEMENT VENDOR AT END 'RV' SET TO 0
115 ; OF CHAIN. 'LOOP' SET TO 1
116 ; VENDOR SELECTED BY USER IS INACTIVE,
117 ; REPLACEMENT VENDOR AT END OF 'RV' SET TO SUBSTITUTE
118 ; CHAIN. VENDOR IEN
119 ; 'LOOP' SET TO 1
120 ;
121 S N10=$G(^PRC(440,+IEN,10))
122 I N10="" S OK=1 Q
123 I $P(N10,U,5)="" S OK=1 Q
124 S N9=$G(^PRC(440,+IEN,9))
125 S RV=+N9
126 I RV=+IEN S LOOP=1,RV=0
127 W !!,"The VENDOR you have chosen is Inactivated."
128 W:RV'>0 !,"You need to select an active vendor.",!!
129 ;
130 ;QUIT IF A REPLACEMENT VENDOR POINTS TO ITSELF
131 ;
132 S LOOP=""
133 F Q:RV=0 S IVCK=$P($G(^PRC(440,RV,10)),U,5) Q:IVCK="" D Q:LOOP=1
134 . S RVX=$G(^PRC(440,RV,9))
135 . I RVX'>0 S LOOP=1 Q
136 . I RV=RVX S LOOP=1 Q
137 . S RV=RVX
138 . Q
139 ;
140 ;PAUSE IF THERE IS NO REPLACEMENT VENDOR TO ALLOW USER TO SEE MESSAGE
141 ;
142 I RV'>0 D
143 . S DIR(0)="E"
144 . S DIR("A")="Press the return key to continue"
145 . D ^DIR
146 . Q
147 W:RV>0 !,"Here is the suggested REPLACEMENT VENDOR.",!!
148 Q
149 ;
150CC ;INPUT TRANSFORM FOR COST CENTER
151 N Z1 S Z0=$P(^PRCS(410,DA,0),"^",5),Z1=$S($D(^(3)):+$P(^(3),"^"),1:0) I 'Z0!('Z1) K X G CC1
152 I '$D(^PRC(420,Z0,1,0))!('$D(^PRC(420,Z0,1,Z1,2,0))) K X G CC1
153 S DIC="^PRC(420,Z0,1,Z1,2,",DIC(0)="QEMZ" D ^DIC I +Y'>0 K X G CC1
154 S X=$P(Y(0),"^") I '$D(^PRCD(420.1,X,0)) K X G CC1
155 S X=$E($P(^PRCD(420.1,X,0),"^"),1,30)
156CC1 K DIC,Z0,Z1 Q
157TRANS ;SET FOR X-REF ON TRANS $ AMT FIELD
158 G TRANS^PRCSEZ
159TRANS1 G TRANS1^PRCSEZ
160TRANK ;KILL FOR X-REF ON TRANS $ AMT FIELD
161 G TRANK^PRCSEZ
162TRANK1 G TRANK1^PRCSEZ
163STATUS ;COMPUTES STATUS OF PO FOR FIELD 54, FILE 410
164 S X="",Y(410)=$S($D(^PRCS(410,D0,10)):$P(^(10),"^",3),1:"")
165 I $D(^PRC(443,D0,0)) S Y(411)=$P(^(0),"^",7) I Y(411),$D(^PRCD(442.3,Y(411),0)) S X=$P(^(0),"^")
166 I Y(410),$D(^PRC(442,Y(410),7)) S Y(410)=$P(^(7),"^") I Y(410),$D(^PRCD(442.3,Y(410),0)) S X=$P(^(0),"^")
167 K Y(410),Y(411) Q
Note: See TracBrowser for help on using the repository browser.