source: FOIAVistA/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPR9AUT.m@ 794

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

initial load of FOIAVistA 6/30/08 version

File size: 5.1 KB
Line 
1RMPR9AUT ;HINES IOFO/RVD - DETAILED PO RPC UTILITY ;09/16/03 13:12
2 ;;3.0;PROSTHETICS;**90,116**;Feb 09, 1996
3 ;input variables:
4 ;DUZ = user
5 ;RMPRSITE = pointer or IEN of file #669.9
6 ;RESULTS = array of all PC number by a user.
7 ;list PC number available to the user
8A1(DUZ,RMPRSITE) G A2
9ENA(RESULTS,DUZ,RMPRSITE) ;broker entry point to list all available PC number.
10A2 ;
11 I $D(^RMPR(669.9,RMPRSITE,4)) S RMIFSITE=$P($G(^RMPR(669.9,RMPRSITE,4)),U,1)
12 I +RMIFSITE'>0 S RESULTS(0)="IFCAP Site is undefined in #669.9" G EXIT1
13 ;call IFCAP routine for the list of PC.
14 D A1^PRCH7PA4(DUZ,RMIFSITE)
15 S N="" F S N=$O(RESULTS(N)) Q:N="" D
16 . I $P(RESULTS(N),U,11)="YES" K RESULTS(N) Q
17 . S X=$P(RESULTS(N),U,13) D ^%DT
18 . I Y'>DT K RESUTLS(N) Q
19EXIT1 ;exit
20 Q
21 ;
22 ;create file 442.
23 ;DUZ = user or initiator of an order
24 ;RMPRSITE = pointer or IEN of file #669.9
25 ;RESULTS = IEN of file #442 ^ PO number (e.g 499-PA1262)
26B1(DUZ,PRCSITE,RMPRSITE,PRCHXXX,PRCHVEN) G B2
27ENB(RESULTS,DUZ,PRCSITE,RMPRSITE,PRCHXXX,PRCHVEN,PRC4426) ;broker entry point
28B2 ;
29 I $D(^RMPR(669.9,RMPRSITE,4)) S RMIFSITE=$P($G(^RMPR(669.9,RMPRSITE,4)),U,1)
30 I '$D(RMIFSITE) S RESULTS(0)="IFCAP Site is undefined in #669.9" G EXIT2
31 ;call ITCAP routine to create a 442 entry.
32 D AD1^PRCH7PA1(DUZ,RMIFSITE,RMPRSITE,PRCHXXX,PRCHVEN,PRC4426)
33 ;
34EXIT2 ;
35 Q
36 ;
37 ;List all Open detailed Purchased Order
38 ;DUZ = user or initiator of an order
39 ;RMPRSITE = pointer or IEN of file #669.9
40 ;RESULTS = array of all open Detailed PO in file #664.
41C1(DUZ,RMPRSITE) G C2
42ENC(RESULTS,DUZ,RMPRSITE) ;broker entry point
43C2 ;
44 S RMCNT=0
45 F I=0:0 S I=$O(^RMPR(664,"H","DETAILED",I)) Q:I'>0 D
46 .D GETS^DIQ(664,I,".01;.5;8","","RM")
47 .Q:$G(RM(664,I_",",8))
48 .S RMCNT=RMCNT+1
49 .S RESULTS(RMCNT)=RM(664,I_",",.01)_U
50 .S RESULTS(RMCNT)=RESULTS(RMCNT)_$G(RM(664,I_",",.5))_U
51 Q
52 ;
53 ;List all Available Cost Center
54 ;RMFCP = Fund Control Point
55 ;RMPRSITE = pointer or IEN of file #669.9
56 ;RESULTS = array of all Cost Center available in a given FCP.
57D1(RMFCP,RMPRSITE) G D2
58END(RESULTS,RMFCP,RMPRSITE) ;broker entry point
59D2 ;
60 I $D(^RMPR(669.9,RMPRSITE,4)) S RMIFSITE=$P($G(^RMPR(669.9,RMPRSITE,4)),U,1)
61 I '$D(RMIFSITE) S RESULTS(0)="IFCAP Site is undefined in #669.9" Q
62 ;access IFCAP API to list available Cost center.
63 D B1^PRCH7PA4(RMFCP,RMIFSITE)
64 Q
65 ;
66 ;List all Available BOC
67 ;RMCC = Cost Center
68 ;RMPRSITE = pointer or IEN of file #669.9
69 ;RESULTS = array of all available BOC in a given Cost Center.
70E1(RMCC,RMPRSITE) G E2
71ENE(RESULTS,RMCC,RMPRSITE) ;broker entry point
72E2 ;
73 I $D(^RMPR(669.9,RMPRSITE,4)) S RMIFSITE=$P($G(^RMPR(669.9,RMPRSITE,4)),U,1)
74 I '$D(RMIFSITE) S RESULTS(0)="IFCAP Site is undefined in #669.9" Q
75 ;access IFCAP API to list available Budget Object Code.
76 D C1^PRCH7PA4(RMCC,RMIFSITE)
77 Q
78 ;
79 ;List all Available FCP
80 ;DUZ = user
81 ;RMPRSITE = pointer or IEN of file #669.9
82 ;RESULTS = array of all available FCP in a given station.
83F1(DUZ,RMPRSITE) G F2
84ENF(RESULTS,DUZ,RMPRSITE) ;broker entry point
85F2 ;
86 I $D(^RMPR(669.9,RMPRSITE,4)) S RMIFSITE=$P($G(^RMPR(669.9,RMPRSITE,4)),U,1)
87 I '$D(RMIFSITE) S RESULTS(0)="IFCAP Site is undefined in #669.9" Q
88 ;access IFCAP API to list available Fund control Point.
89 D D1^PRCH7PA4(DUZ,RMIFSITE)
90 Q
91 ;
92 ;Broker call to link suspense to 2319
93 ;RMPR64 = ien of file #664
94 ;RMPR68 = ien of file #668
95 ;RESULTS = success or failure message.
96G1(RMPR64,RMPR68) G G2
97ENG(RESULTS,RMPR64,RMPR68) ;broker entry point
98G2 ;
99 N RMAMIS,RMIDAT,RMIEN60,RMERCHK,RMAR
100 S RESULTS=""
101 ;do automatic linking to suspense.
102 ;loop all the item and get the pointer to 660.
103 F I=0:0 S I=$O(^RMPR(664,RMPR64,1,I)) Q:(I'>0)!(RESULTS'="") D
104 .S RMIDAT=$G(^RMPR(664,RMPR64,1,I,0))
105 .S RMIEN60=$P(RMIDAT,U,13)
106 .Q:'$G(RMIEN60)
107 .S RMAMIS=""
108 .I $D(^RMPR(660,RMIEN60,"AMS")) S RMAMIS=$G(^RMPR(660,RMIEN60,"AMS"))
109 .Q:'$G(RMAMIS)
110 .S RMERCHK=0
111 .S RMERCHK=$$UP60^RMPRPCE1(RMIEN60,RMPR68,1)
112 .I $G(RMERCHK) S RESULTS="Error Linking to file #660" Q
113 .S RMERCHK=$$UP68^RMPRPCE1(RMIEN60,RMPR68,RMAMIS)
114 .I $G(RMERCHK) S RESULTS="Error Linking to file #668" Q
115 I RESULTS="" S RESULTS="PCE linking to suspense is complete"
116 Q
117 ;
118 ;Broker call to list vendor.
119 ;RMPR40 = ien of file #440
120 ;RESULTS = success or failure message.
121H1(RMPR40,RMPRSITE) G H2
122ENH(RESULTS,RMPR40,RMPRSITE) ;broker entry point
123H2 ;
124 I $D(^RMPR(669.9,RMPRSITE,4)) S RMIFSITE=$P($G(^RMPR(669.9,RMPRSITE,4)),U,1)
125 I '$D(RMIFSITE) S RESULTS(0)="IFCAP Site is undefined in #669.9" Q
126 ;call ifcap API for vendor listing.
127 D E1^PRCH7PA4(RMPR40)
128 Q
129 ;broker call to ask for electronic signature code
130 ;DUZ - user IEN
131 ;X - electronic code entered by user.
132 ;RESULTS - failure or success message.
133I1(DUZ,X) G I2
134ENI(RESULTS,DUZ,X) ;broker entry point
135I2 ;
136 N RMCODE
137 S RMCODE=$P($G(^VA(200,DUZ,20)),"^",4)
138 I RMCODE="" S RESULTS="You have no signature code on file." Q
139 ;W !,"Enter Electronic signature Code: "
140 ;X ^%ZOSF("EOFF") R X:60 X ^%ZOSF("EON")
141 ;I '$T S RESULTS="Failure" Q
142 I $E(X)="^" S RESULTS="User up arrowed out." Q
143 S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
144 I $$HASH(X)=RMCODE S RESULTS="Thank you." Q
145 S RESULTS="Sorry, but that's not your correct electronic signature code."
146 Q
147HASH(X) D HASH^XUSHSHP
148 Q X
149 ;END
Note: See TracBrowser for help on using the repository browser.