source: FOIAVistA/trunk/r/ASISTS-OOPS/OOPSGUI6.m@ 847

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

initial load of FOIAVistA 6/30/08 version

File size: 8.6 KB
Line 
1OOPSGUI6 ;WIOFO/LLH-RPC routines for ASISTS Gui ;9/18/01
2 ;;2.0;ASISTS;**4,8,7**;Jun 03, 2002
3 ;
4UNIGET(RESULTS) ; Returns entries in the Union table
5 N DATA,CNT,SUP,UIEN,UNI
6 S CNT=0,UNI=""
7 F S UNI=$O(^OOPS(2263.7,"B",UNI)) Q:UNI="" D
8 .S UIEN=0
9 .F S UIEN=$O(^OOPS(2263.7,"B",UNI,UIEN)) Q:UIEN="" D
10 ..S DATA=$G(^OOPS(2263.7,UIEN,0))
11 ..S SUP=$$GET1^DIQ(200,$P($G(DATA),U,3),.01)
12 ..S RESULTS(CNT)=DATA_U_SUP_U_UIEN,CNT=CNT+1
13 Q
14UNIKILL(RESULTS,INPUT) ;
15 ; Input - INPUT contains the IEN for Union to be deleted
16 ; Output - RESULTS will contain a message indicating the record
17 ; was successfully deleted.
18 N DA,DIK
19 S RESULTS="No Changes Filed"
20 S DIK="^OOPS(2263.7,",DA=INPUT
21 D ^DIK
22 S RESULTS="Record Successfully Deleted"
23 Q
24UNIADD ; Files a new record in ^OOPS(2263.7
25 N X,DIC,DLAYGO
26 K DO
27 S DLAYGO=2263.7,DIC="^OOPS(2263.7,",DIC(0)="L",X=NM
28 D FILE^DICN
29 I Y=-1 S RESULTS="Failed" Q
30 S DA=+Y,RESULTS=X_" union added"
31 Q
32UNIEDT(RESULTS,INPUT) ; Edits the input in ^OOPS(2263.7
33 ; Input - INPUT contains the IEN of Union to be edited or NULL if a
34 ; new union is being added. Also has the Union Name,
35 ; Acronym, and Representative in the format:
36 ; IEN^UNION NAME^UNION ACRONYM^UNION REP
37 ; Output - RESULTS contains a status message regarding the filing of
38 ; the data
39 N DA,DIE,DR,IEN,NM,ACR,REP
40 S RESULTS="No Changes Filed"
41 S DIE="^OOPS(2263.7,",IEN=$P($G(INPUT),U),NM=$P($G(INPUT),U,2)
42 I $G(NM)="" Q
43 I $G(IEN)="" D UNIADD S IEN=DA
44 I RESULTS="Failed" Q
45 S ACR=$P($G(INPUT),U,3),REP=$P($G(INPUT),U,4)
46 S DA=IEN,DR=".01///^S X=NM;1///^S X=ACR;2///^S X=REP"
47 D ^DIE
48 I $G(Y)="" D Q
49 .;if next line executed, then straight edit, not an add
50 .I RESULTS="No Changes Filed" S RESULTS="Union Update Successful."
51 S RESULTS="Union Update NOT Successful."
52 Q
53SITEPGET(RESULTS,FORM) ;
54 ; Input - FORM = contains either a blank for 'normal' site parameter
55 ; look ups or 'OSHA300' if for the OSHA 300A summary input
56 ; Output - RESULTS is an array whose 0 node contains the Site
57 ; parameter name, IEN, and District Office in the format:
58 ; SITE NAME^DISTRICT OFFICE^SITE IEN
59 ; Subsequent nodes starting from 1 contain Station information
60 ; in the following format:
61 ; STANM_U_PNM_U_PADD_U_PCTY_U_PST_U_PZIP_U_PTITLE_
62 ; U_CHGBKCODE_U_SUB_U_STA
63 N CNT,DOFF,IENS,SIEN,STA,SUB,SNAME,STR,STR2,CBCSUF
64 S SIEN=$P($G(^OOPS(2262,0)),U,3)
65 N CBC,STANM,STATION,PNM,PADD,PCTY,PST,PZIP,PTITLE
66 S (CBC,STATION,PNM,PADD,PCTY,PST,PZIP,PTITLE)=""
67 N NA,TTL,PHN,EXT,IND,NAICS,SIC
68 S (NA,TTL,PHN,EXT,IND,NAICS,SIC)=""
69 I '$G(SIEN) S RESULTS(0)="No Site Parameter File was Found" Q
70 L +^OOPS(2262,SIEN):2
71 E S RESULTS(0)="This option in use by another user, try again later." Q
72 S SNAME=$$GET1^DIQ(2262,SIEN,.01),DOFF=$$GET1^DIQ(2262,SIEN,2,"E")
73 S RESULTS(0)=SNAME_U_DOFF_U_SIEN
74 S CNT=1,SUB=""
75 F S SUB=$O(^OOPS(2262,SIEN,SUB)) Q:SUB="" S STA=0 D
76 .F S STA=$O(^OOPS(2262,SIEN,SUB,STA)) Q:STA'>0 D
77 ..S STR=$G(^OOPS(2262,SIEN,SUB,STA,0)),IENS=STA_","_SUB_","
78 ..S STR2=$G(^OOPS(2262,SIEN,SUB,STA,1))
79 ..S STATION=$$GET1^DIQ(2262.03,IENS,".01:99")
80 ..S STANM=$$GET1^DIQ(2262.03,IENS,.01)_" = "_STATION
81 ..; Patch 5 llh - if station inactive blank STA
82 ..I $$GET1^DIQ(4,$P(STR,U),101)'="" S STA=""
83 ..I $G(FORM)="" D
84 ...S PNM=$P(STR,U,2),PADD=$P(STR,U,3),PCTY=$P(STR,U,4),PZIP=$P(STR,U,6)
85 ...I $P(STR,U,5)'="" S PST=$$GET1^DIQ(2262.03,IENS,4)
86 ...I $P(STR,U,7)'="" S PTITLE=$$GET1^DIQ(2262.03,IENS,6)
87 ...S CBC=$P(STR,U,8) I $G(CBC)'="" S CBC=$$GET1^DIQ(2263.6,CBC,.01)
88 ...;Patch 5 llh - added CBCSUF sets
89 ...S CBCSUF=$P(STR,U,9)
90 ...S RESULTS(CNT)=STANM_U_PNM_U_PADD_U_PCTY_U_PST_U_PZIP_U_PTITLE_U_CBC_U_SUB_U_STA_U_CBCSUF
91 ..I $G(FORM)="OSHA300" D
92 ...I $P(STR2,U,1)'="" S NA=$$GET1^DIQ(2262.03,IENS,7)
93 ...S TTL=$P(STR2,U,2),PHN=$P(STR2,U,3),EXT=$P(STR2,U,4)
94 ...S IND=$P(STR2,U,5),SIC=$$GET1^DIQ(2262.03,IENS,12)
95 ...S NAICS=$$GET1^DIQ(2262.03,IENS,13)
96 ...S RESULTS(CNT)=STANM_U_NA_U_TTL_U_PHN_U_EXT_U_IND_U_SIC_U_NAICS_U_SUB_U_STA_U_$P(STR,U,1)_U
97 ..I $G(FORM)="" S (STANM,PNM,PADD,PCTY,PST,PZIP,PTITLE,CBC,CBCSUF)=""
98 ..E S (NA,TTL,PHN,EXT,IND,NAICS,SIC)=""
99 ..S CNT=CNT+1
100 L -^OOPS(2262,SIEN)
101 Q
102SITEPADD ; Creates a new Station Subfile in the Site Parameter
103 ; File (#2262
104 N X,DIC,DLAYGO
105 S DLAYGO=2262,DIC="^OOPS(2262,"_SIEN_","_SUBF_",",DIC(0)="L"
106 S DA(1)=SIEN,X=STANM
107 D FILE^DICN
108 I Y=-1 S RESULTS="Failed" Q
109 S DA=+Y,RESULTS="Successfully Added"
110 Q
111SITEPKIL(RESULTS,INPUT) ; Deletes the Station Subfile whose IEN was passed in
112 ; Input - INPUT contains the Site Parameter file IEN, the subfile IEN,
113 ; and the Station IEN in the format: SIEN^SUBF^STAIEN
114 ; Output - RESULTS contains a message with the filing status
115 N DA,DIK,SIEN,SUBF,STAIEN
116 S SIEN=$P($G(INPUT),U),SUBF=$P($G(INPUT),U,2),STAIEN=$P($G(INPUT),U,3)
117 I $G(SIEN)=""!($G(SUBF)="")!($G(STAIEN)="") D Q
118 .S RESULTS="Missing Record Identifiers, Cannot file."
119 S DIK="^OOPS(2262,"_SIEN_","_SUBF_","
120 S DA=STAIEN,DA(1)=SIEN
121 D ^DIK
122 I $G(Y)="" S RESULTS="Deletion did not occur." Q
123 S RESULTS="Record successfully deleted"
124 Q
125SITEPEDT(RESULTS,INPUT,DATA,FORM) ;
126 ; Edits the Station Subfile whose data and IEN have been passed in
127 ; Input - INPUT contains the IEN of the Site Parameter file, subfile
128 ; & Station IEN. If adding new station, the Station IEN
129 ; = "". INPUT format: SITE IEN^SUBFILE IEN^STATION IEN
130 ; DATA contains the data to be filed
131 ; FORM is either "" or "OSHA300" to signify data for filing
132 ; Output - RESULTS is a single value with a message regarding the
133 ; filing status
134 N CBC,DA,DIE,DR,PNM,PADD,PCTY,PST,PZIP,PTITLE,SIEN,SUBF,CBCSUF
135 N STANM,STAIEN,NA,TTL,PHN,EXT,IND,SIC,NAICS
136 S RESULTS="Filing"
137 S SIEN=$P($G(INPUT),U),SUBF=$P($G(INPUT),U,2),STAIEN=$P($G(INPUT),U,3)
138 I $G(SIEN)="" S RESULTS="Missing Record Identifiers, Cannot file." Q
139 I '$G(SUBF) S SUBF=$O(^OOPS(2262,SIEN,0)) I '$G(SUBF) S SUBF=1
140 S STANM=$P($G(DATA),U)
141 I $G(STANM)="" S RESULTS="Missing Station, Cannot continue." Q
142 I $G(STAIEN)="" D SITEPADD S STAIEN=DA
143 I $G(STAIEN)="" S RESULTS="Missing Station, cannot file." Q
144 S DIE="^OOPS(2262,"_SIEN_","_SUBF_","
145 S DA=STAIEN,DA(1)=SIEN,DR=""
146 I $G(FORM)="" D
147 .S PNM=$P($G(DATA),U,2),PADD=$P($G(DATA),U,3)
148 .S PCTY=$P($G(DATA),U,4),PST=$P($G(DATA),U,5),PZIP=$P($G(DATA),U,6)
149 .S PTITLE=$P($G(DATA),U,7),CBC=$P($G(DATA),U,8)
150 .; Patch 5 llh - Added CBCSUF sets
151 .S CBCSUF=$P($G(DATA),U,9)
152 .S DR=".7///^S X=CBC;.8///^S X=CBCSUF;1///^S X=PNM;2///^S X=PADD;3///^S X=PCTY;4///^S X=PST;5///^S X=PZIP;6///^S X=PTITLE"
153 I $G(FORM)="OSHA300" D
154 .S NA=$P($G(DATA),U,2),TTL=$P($G(DATA),U,3),PHN=$P($G(DATA),U,4)
155 .S EXT=$P($G(DATA),U,5),IND=$P($G(DATA),U,6),SIC=$P($G(DATA),U,7)
156 .S NAICS=$P($G(DATA),U,8)
157 .S DR="7///^S X=NA;8///^S X=TTL;9///^S X=PHN;10///^S X=EXT"
158 .S DR=DR_";11///^S X=IND;12///^S X=SIC;13///^S X=NAICS"
159 I $G(DR)'="" D ^DIE
160 I $G(Y)="" D Q
161 .; if line below executed, then no Add, only edit
162 .I RESULTS="Filing" S RESULTS="Update Successful"
163 S RESULTS="Update was not Successful"
164 Q
165PARMEDT(RESULTS,INPUT) ; Files changes to top level file (#2262)
166 ; Input: INPUT - This variable contains the IEN, Site Name, and
167 ; District Office Name to be filed in the format:
168 ; IEN^SITE NAME^DISTRICT OFFICE
169 ; Output: RESULTS - Results will contain a filing status message
170 N DA,DIE,DR,IEN,SITENM,DISOFF
171 S IEN=$P($G(INPUT),U),SITENM=$P($G(INPUT),U,2),DISOFF=$P($G(INPUT),U,3)
172 I '$G(IEN) S RESULTS="Cannot File Changes, no Record Number" Q
173 S DIE="^OOPS(2262,",DA=IEN
174 S DR=".01///^S X=SITENM;2///^S X=DISOFF"
175 D ^DIE
176 I $G(Y)="" S RESULTS="Update Site data Successful" Q
177 S RESULTS="Update Site data was NOT Successful"
178 Q
179CHGCASE(RESULTS,INPUT,FLD58) ; File Change Case Status
180 ; Input: INPUT - IEN^STAT where IEN = the ASISTS case IEN and
181 ; STAT = the new case status
182 ; DELETE - Reason for Deletion, field #58, file #2260
183 ; Output: RESULTS - Message back to client with new Case Status
184 ;
185 N CURRENT,DR,DIE,IEN,Y,STATUS
186 S IEN=$P(INPUT,U),(STATUS,Y)=$P(INPUT,U,2)
187 I '$G(IEN) S RESULTS="Missing Record Identifier, cannot file." Q
188 I $$GET1^DIQ(2260,IEN,66)'="",(Y=2) D Q
189 .S RESULTS="Case transmitted to DOL, cannot change status to Deleted."
190 S CURRENT=$$GET1^DIQ(2260,IEN,51,"I")
191CLOSE ; Close
192 S DR=""
193 S DR="51////"_Y
194 ;If current status goes from closed/deleted to Open, reset field 57
195 I (CURRENT=1!(CURRENT=2)),(Y=0) S DR=DR_";57////@"
196 I FLD58]"" S DR=DR_";58////"_FLD58
197 S DIE="^OOPS(2260,",DA=IEN
198 D ^DIE K DIE,DA
199 I $D(Y)'=0 Q
200 S RESULTS="Case Status has been changed to: "_$$GET1^DIQ(2260,IEN,51)
201 ;01/02/04 Patch 4 llh- if case = closed, send bulletin
202 I STATUS=1 D CLSCASE^OOPSMBUL(IEN)
203 Q
Note: See TracBrowser for help on using the repository browser.