source: WorldVistAEHR/trunk/r/ASISTS-OOPS/OOPSGUI3.m@ 699

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

initial load of WorldVistAEHR

File size: 7.6 KB
Line 
1OOPSGUI3 ;WIOFO/LLH-UTILITY BROKER CALLS ;10/03/01
2 ;;2.0;ASISTS;**8,7**;Jun 03, 2002
3 ;
4SETLCK(RESULTS,IEN) ; Set Lock on Claim being edited
5 ; Input: IEN - ASISTS Internal record number to be locked
6 ; Output: RESULTS - Status message, if record not locked
7 ;
8 I '$G(IEN) S RESULTS="Need Record Number to proceed" Q
9 L +^OOPS(2260,IEN):2
10 E S RESULTS="Another User Editing Record, Try Again Later." Q
11 S RESULTS="RECORD LOCKED"
12 Q
13CLRLCK(RESULTS,IEN) ; Clears Lock on Claim being edited
14 ; Input: IEN - ASISTS Internal record number to be cleared
15 ; Output: RESULTS - Status message, if appropriate
16 ;
17 I '$G(IEN) S RESULTS="Need Record Number to proceed" Q
18 L -^OOPS(2260,IEN)
19 S RESULTS="RECORD UNLOCKED"
20 Q
21GETLIST(RESULTS,FLD) ; RPC Call - Get Pointed to List
22 ; Input: FLD - will be the file and field # in FILE,FIELD format.
23 ; if there is a 3 piece of FLD, it will contain the
24 ; piece number of an extra data element to be
25 ; returned. The format is FILE^FIELD^PIECE#
26 ; Output: RESULTS - return array
27 ;
28 N FILE,FIELD,TYPE
29 S FILE=$P($G(FLD),U),FIELD=$P($G(FLD),U,2)
30 S TYPE=$$GET1^DID(FILE,FIELD,"","TYPE")
31 I TYPE="SET" D SET1 Q
32 I TYPE="POINTER" D SET3 Q
33 Q
34SET1 ;-- extract a set of codes --
35EN2 N LIST,MUTL,X
36 S LIST=$$GET1^DID(2260,FIELD,"","POINTER")
37 I $E(LIST,1,3)="OOPS" G SET3
38 S MULT=$$GET1^DID(2260,FIELD,"","SPECIFIER")
39 I MULT["A" D
40 . S LIST=$$GET1^DID(+MULT,.01,"","POINTER")
41 F X=1:1 Q:$P($G(LIST),";",X)']"" S RESULTS(X)=$P($G(LIST),";",X)
42 Q
43SET3 ;-- extract items from pointed-to file --
44 N ADDED,ITEM,MULT,ROOT,X,XREF,SFLD,VAL,PTR,PCE,VALID
45 S XREF="B",X=0
46 S ROOT="^"_$$GET1^DID(FILE,FIELD,"","POINTER")
47 S MULT=$$GET1^DID(FILE,FIELD,"","SPECIFIER")
48 I MULT["A" D
49 . S ROOT="^"_$$GET1^DID(+MULT,.01,"","POINTER")
50 S ITEM="" F S ITEM=$O(@(ROOT_"XREF,ITEM)")) Q:$G(ITEM)']"" D
51 .S PTR=0 F S PTR=$O(@(ROOT_"XREF,ITEM,PTR)")) Q:PTR="" D
52 ..I PTR'?1N.N Q
53 ..S VAL=$P(@(ROOT_PTR_",0)"),U)
54 ..;Need to get Station Number with Name to uniquely identify for user
55 ..I FIELD=13 D I '$G(VALID) Q
56 ...S VALID=1,SFLD=ROOT_PTR_",99)"
57 ...I $P($G(@SFLD),U,4)=1 S VALID=0
58 ...I $P($G(@SFLD),U)'="" S VAL=VAL_" = "_$P($G(@SFLD),U)
59 ...I $P(VAL," = ")="" S VALID=0
60 ..I (FILE=2260)&(FIELD=30!(FIELD=62)!(FIELD=70)!(FIELD=123)!(FIELD=124)!(FIELD=126)) D
61 ... S SFLD=ROOT_PTR_",0)"
62 ... I $P($G(@SFLD),U,2)'="" S VAL=VAL_" - "_$P($G(@SFLD),U,2)
63 ..S X=X+1,RESULTS(X)=PTR_":"_VAL
64 ..I $P($G(FLD),U,3)]"" D
65 ...S PCE=$P($G(FLD),U,3)
66 ...S RESULTS(X)=RESULTS(X)_":"_$P(@(ROOT_"PTR,0)"),U,PCE)
67 Q
68 ;
69GETSCHED(RESULTS,INPUT) ;
70 ; Input: INPUT - Is the file, field #, and IEN in
71 ; FILE^FIELD^IEN fmt
72 ; Output: RESULTS - return array (Integers indicating schedule)
73 ;
74 S RESULTS(1)="*"
75 N CODE,LAST,DATA,DAY,Y,X,FIELD,FILE,IEN,ROOT,XREF,NODE,PIECE
76 S FILE=$P($G(INPUT),U),FIELD=$P($G(INPUT),U,2)
77 S IEN=$P($G(INPUT),U,3),ROOT=$$GET1^DID(FILE,"","","GLOBAL NAME")
78 I '$G(IEN) Q
79 S XREF=$$GET1^DID(FILE,FIELD,"","GLOBAL SUBSCRIPT LOCATION")
80 S NODE=$P($G(XREF),";"),PIECE=$P($G(XREF),";",2)
81 S CODE=$P($G(@(ROOT_"IEN,NODE)")),U,PIECE) Q:$G(CODE)']""
82 S LAST=$L(CODE,",")
83 F X=1:1:LAST D
84 .S DATA=$P($G(CODE),",",X) Q:$G(DATA)']"" D
85 .I $G(DATA)'["-" S DAY(DATA)=$G(DATA) Q
86 .F Y=$P(DATA,"-",1):1:$P(DATA,"-",2) S DAY(Y)=Y
87 S X=0
88 F D Q:+X'>0
89 .S X=$O(DAY(X)) Q:+X'>0 S RESULTS(1)=RESULTS(1)_","_X
90 Q
91 ;
92REPLMULT(RESULTS,INPUT,DATA) ;
93 ; Input: INPUT - contains the FILE, FIELD, and IEN of the record
94 ; to have the data filed into.
95 ; DATA - contains the replacement data (internal code/ptr)
96 ; Output: RESULTS - results array to be sent back to client
97 ;
98 D REPLIN,REPLDEL,REPLADD
99 K DA,DIK,FILE,FIELD,NODE,ROOT,SAVEDIK,SUB
100 Q
101REPLIN ;
102 S FILE=$P($G(INPUT),U),FIELD=$P($G(INPUT),U,2),DA(1)=$P($G(INPUT),U,3)
103 S ROOT=$$ROOT^DILFD(FILE,0,"GL")
104 S SUB=$$GET1^DID(2260,FIELD,"","GLOBAL SUBSCRIPT LOCATION")
105 S NODE=$P($G(SUB),";"),PCE=$P($G(SUB),";",2)
106 S SAVEDIK=ROOT_DA(1)_","_$C(34)_NODE_$C(34)_","
107 Q
108REPLDEL ;
109 S DA=0,DIK=SAVEDIK
110 F S DA=$O(@(ROOT_"DA(1),NODE,DA)")) Q:(+DA'>0) D ^DIK
111 Q
112REPLADD ;
113 N CNT,DIC,DLAYGO,X
114 S DLAYGO=DA(1),DIC=SAVEDIK,DIC(0)="LNX"
115 S CNT=0
116 F D Q:+CNT'>0
117 . S CNT=$O(DATA(CNT)) Q:+CNT'>0
118 . S X=DATA(CNT)
119 . K DD,DO D FILE^DICN
120 Q
121 ;
122BODY(RESULTS) ; get valid Body Parts from file 2261.1
123 ; Input: - none
124 ; Output: RESULTS - an array containing the body parts
125 ;
126 N PP,COUNT,DATA,BPIEN,BPGRP,BODY
127 S (PP,COUNT)=0
128 F S PP=$O(^OOPS(2261.1,PP)) Q:+PP'>0 D
129 . Q:$P(^OOPS(2261.1,PP,0),U,2)=0
130 . Q:+$P(^OOPS(2261.1,PP,0),U,2)>0
131 . S DATA=^OOPS(2261.1,PP,0)
132 . ; patch 5 llh - get Body Part Group IEN and Name and send back
133 . S BPIEN=$P($G(DATA),U,3),BPGRP=""
134 . I $G(BPIEN) S BPGRP=$P($G(^OOPS(2263.8,BPIEN,0)),U) D
135 .. S BODY(BPGRP)=BPIEN
136 . S RESULTS(COUNT)=$P(DATA,U)_" - "_$P(DATA,U,2)_U_BPGRP
137 . S COUNT=COUNT+1
138 S BPGRP=""
139 F S BPGRP=$O(BODY(BPGRP)) Q:BPGRP="" D
140 . S RESULTS(COUNT)=U_BPGRP_U_BODY(BPGRP),COUNT=COUNT+1
141 QUIT
142GETDATA(RESULTS,INPUT) ; Retrieves Set of Code, WP, and Multiple valued fields
143 ; for any file and field passed in the INPUT parameter
144 ; Input - INPUT contains the File & Field # of the file to retrieve the
145 ; data from and the File IEN. The format is FILE^FIELD^IEN
146 ; Output - RESULTS, the array containing the data being returned
147 ;
148 N IEN,FILE,FIELD,NODE,PCE,ROOT,TYP,SUB
149 S FILE=$P($G(INPUT),U),FIELD=$P($G(INPUT),U,2),IEN=$P($G(INPUT),U,3)
150 I $G(IEN)=""!($G(FILE)="")!($G(FIELD)="") Q
151 S ROOT=$$ROOT^DILFD(FILE,0,"GL")
152 S TYP=$$GET1^DID(FILE,FIELD,"","TYPE")
153 S SUB=$$GET1^DID(FILE,FIELD,"","GLOBAL SUBSCRIPT LOCATION")
154 S NODE=$P($G(SUB),";"),PCE=$P($G(SUB),";",2)
155 I TYP="POINTER",PCE>0 D PTR Q
156 I TYP="POINTER",PCE=0 D PTRMULT Q
157 I TYP="SET",PCE>0 D SET Q
158 I TYP="SET",PCE=0 D SETMULT Q
159 I TYP="WORD-PROCESSING" D WPFLD Q
160 Q
161SET ;
162 N CODE,LIST,X
163 S CODE=$P(@(ROOT_"IEN,NODE)"),U,PCE)
164EN1 S LIST=$$GET1^DID(FILE,FIELD,"","SPECIFIER")
165 I +LIST S FILE=+LIST,FIELD=.01 G EN1
166 S LIST=$$GET1^DID(FILE,FIELD,"","POINTER")
167 I $G(LIST)="" Q
168 F X=1:1 Q:$P(LIST,";",X)']"" I $P($P(LIST,";",X),":")=CODE S RESULTS(1)=$P(LIST,";",X)
169 Q
170 ;
171SETMULT ;
172 N A,LIST,REC,DATA,X
173ENM S LIST=$$GET1^DID(FILE,FIELD,"","SPECIFIER")
174 I +LIST S FILE=+LIST,FIELD=.01 G ENM
175 S LIST=$$GET1^DID(FILE,FIELD,"","POINTER")
176 I $G(LIST)="" Q
177 S (REC,X)=0 F D Q:+REC'>0
178 .S REC=$O(@(ROOT_"IEN,NODE,REC)")) Q:+REC'>0
179 .S DATA=@(ROOT_"IEN,NODE,REC,0)")
180 .S A=$P($G(LIST),DATA_":",2)
181 .S X=X+1
182 .S RESULTS(X)=$G(DATA)_":"_$P($G(A),";")
183 Q
184PTR ; Pointer fields
185 N PTR,PROOT
186 S PTR=$P(@(ROOT_"IEN,NODE)"),U,PIECE)
187 S PROOT="^"_$$GET1^DID(FILE,FIELD,"","POINTER")
188 S RESULTS(1)=PTR_":"_$P(@(PROOT_"PTR,0)"),U,1)
189 Q
190PTRMULT ; Multiple pointer value fields
191 N DATA,XROOT,PROOT,REC,RECORD,X
192 S XROOT=+$$GET1^DID(FILE,FIELD,"","SPECIFIER")
193 S PROOT="^"_$$GET1^DID(XROOT,.01,"","POINTER")
194 S (REC,X)=0 F D Q:+REC'>0
195 .S REC=$O(@(ROOT_"IEN,NODE,REC)")) Q:+REC'>0
196 .S RECORD=@(ROOT_"IEN,NODE,REC,0)")
197 .S DATA=$P($G(RECORD),U,1)
198 .S X=X+1,RESULTS(X)=$G(DATA)_":"_$P(@(PROOT_"DATA,0)"),U,1)
199 Q
200WPFLD ; Word processing fields
201 N DA
202 S DA=0 F D Q:+DA'>0
203 .S DA=$O(@(ROOT_"IEN,NODE,DA)")) Q:+DA'>0
204 .S RESULTS(DA)=@(ROOT_"IEN,NODE,DA,0)")
205 Q
206 ;
207STATINFO(RESULTS,STATIEN) ;Get Station Info from DIC(4
208 ; Input STATIEN - Required valid IEN for a station in DIC 4.
209 ; Output RESULTS - Station Address info stored in this format
210 ; STREET^CITY^STATE^ZIP or if not a valid IEN
211 ; "INVALID STATION"
212 N STATE,CITY,ADDR,ZIP
213 I $$GET1^DIQ(4,STATIEN,.01)="" S RESULTS(0)="INVALID STATION" Q
214 S STATE=$$GET1^DIQ(4,STATIEN,.02)
215 S CITY=$$GET1^DIQ(4,STATIEN,1.03)
216 S ADDR=$$GET1^DIQ(4,STATIEN,1.01)
217 S ZIP=$$GET1^DIQ(4,STATIEN,1.04)
218 S RESULTS(0)=ADDR_U_CITY_U_STATE_U_ZIP
219 Q
Note: See TracBrowser for help on using the repository browser.