source: FOIAVistA/trunk/r/ASISTS-OOPS/OOPSGUI7.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 6.3 KB
Line 
1OOPSGUI7 ;WIOFO/LLH-RPC routines ;10/30/01
2 ;;2.0;ASISTS;**2,4,7**;Jun 03, 2002
3 ;
4ENT(RESULTS,INPUT) ; Non-interactive GUI Entry Point for transmitting data
5 ; to DOL or NDB
6 ; Input: INPUT - Contains the date for the claims to be
7 ; retransmitted, the queue date and time for the
8 ; retransmission date to run and either DOL or NDB
9 ; to indicate which manual transmission should run.
10 ; The format is TRANSDT^QUEUEDT@TIME^DOL (or NDB)
11 ; Output: RESULTS - is the return array to the client with status
12 ; message
13 N ARR,COMMA,ERR1,ERR2,FIELD,FL,MAILG,CURR,QDATE,QUE,RDATE,RTN,X,Y
14 N MAN,WOK,ZTDESC,ZTREQ,ZTRTN
15 S RTN=$P($G(INPUT),U,3)
16 S MAN=1 ; force manual xmit flag
17 I RTN="DOL" D
18 . S MAILG="OOPS DOL XMIT DATA"
19 . S QUE="Q-AST.MED.VA.GOV"
20 I RTN="NDB" D
21 . S MAILG="OOPS XMIT 2162 DATA"
22 . S QUE="Q-ASI.MED.VA.GOV"
23 ;Check for security keys
24 I '$D(^XUSEC(MAILG,DUZ)) D Q
25 .S RESULTS(0)="ERROR"
26 .S RESULTS(1)="You do not have the required Security Key."
27 ;Assure the Queue has been defined
28 S FIELD=.01,FL="X"
29 D FIND^DIC(4.2,"",FIELD,FL,QUE,"","","","","ARR")
30 I '$D(ARR("DILIST",1)) D Q
31 .S RESULTS(0)="ERROR"
32 .S RESULTS(1)="Domain not found in the DOMAIN File,"
33 ; Get Retransmit Date from First Piece of Input & Translate into FM
34 S X=$P($G(INPUT),U) D ^%DT
35 S RDATE=Y
36 I RDATE=-1 S ERR1=1
37 S %DT="R",X=$P($G(INPUT),U,2) D ^%DT K %DT
38 S QDATE=Y
39 I QDATE=-1 S ERR2=2
40 I $G(ERR1)!($G(ERR2)) D Q
41 . S RESULTS(0)="ERROR",RESULTS(1)="",COMMA=""
42 . S:$G(ERR1) RESULTS(1)="Invalid Transmission Date",COMMA=", "
43 . S:$G(ERR2) RESULTS(1)=RESULTS(1)_COMMA_"Invalid Queue Date."
44 ;
45 I RTN="DOL" D
46 . S ZTRTN="EN^OOPSDOL",WOK=1,ZTDESC="TRANSMIT DOL CA1/CA2 DATA"
47 I RTN="NDB" D
48 . S ZTRTN="EN^OOPSNDB",ZTDESC="TRANSMIT NATIONAL DATABASE 2162 DATA"
49 ; Make sure Queue date/time is not after current time
50 S CURR=$$HTFM^XLFDT(""_$H_"")
51 I $$FMDIFF^XLFDT(QDATE,CURR,2)<0 S QDATE=$H
52 ; Report will always be Queued from the GUI
53 K IO("Q"),ZTUCI,ZTDTH,ZTIO,ZTSAVE
54 S ZTDTH=QDATE,ZTIO="",ZTREQ="@",ZTSAVE("ZTREQ")=""
55 S ZTSAVE("RDATE")="",ZTSAVE("MAN")=""
56 D ^%ZTLOAD
57 K ZTSK
58 S RESULTS(0)="SUCCESSFULLY QUEUED"
59 Q
60OWCPCLR(RESULTS,IEN,CALLER,FORM) ; Entry point for clearing supervisor
61 ; fields if OWPC worker has edited them
62 ; Input: IEN - ien of case to have the fields cleared
63 ; CALLER - menu being called from
64 ; FORM - whether a CA1 or CA2
65 ; Output: RESULTS - required results parameter, no data returned
66 ; from this call
67 I $G(IEN)=""!($G(CALLER)="")!($G(FORM)="") Q
68 D CLRFLDS^OOPSWCE
69SUPFLDS ; Clear Supervisor fields for the CA1, since fields have been changed
70 I FORM'="CA1" Q
71 N SUP
72 S SUP=$$GET1^DIQ(200,DUZ,.01)
73 S RESULTS=SUP
74 S $P(^OOPS(2260,IEN,"CA1L"),U,3)="" ;Clear EXCEPTION
75 S $P(^OOPS(2260,IEN,"CA1L"),U,4)="" ;Clear SUP TITLE
76 S $P(^OOPS(2260,IEN,"CA1L"),U,5)="" ;Clear SUP PHONE
77 Q
78CONSENT(RESULTS,IEN,UNIREP) ; Employee consented to union notification,
79 ; send msg to union
80 ; Input
81 ; IEN - Internal record number
82 ; UNIREP - IEN from file 200 of the Union Rep - used to send bulletin
83 ; Output - RESULTS - String indicating bulletin status.
84 D CONSENT^OOPSMBUL(IEN,UNIREP)
85 Q
86GETFLD(RESULTS,IEN,FLD) ; Send in IEN and Field number to retrieve a single
87 ; data field from the ASISTS Accident Reporting File (#2260)
88 ;
89 ; Input: IEN - Internal record number
90 ; Output: FLD - the file and field number of the data element to be
91 ; retrieved. EX. 2260^120
92 N FILE,FIELD,DATA
93 S RESULTS="No data."
94 I '$G(IEN) S RESULTS="No data. Missing Record Identifier." Q
95 S FILE=$P(FLD,U),FIELD=$P(FLD,U,2)
96 I $G(FILE)=""!($G(FIELD)="") D Q
97 . S RESULTS="No data. Missing File or Field information."
98 ; This should only get called when OOPS*2.0*7 is 1st released, used
99 ; to get hire date if it's blank and personnel status is employee
100 I FIELD=336 D Q
101 .N SSN,STR S SSN=$$GET1^DIQ(FILE,IEN,5,"I")
102 .D FIND^DIC(450,,"@;.01;30","PS",SSN,"","SSN")
103 .S STR=$P(^TMP("DILIST",$J,0),U) I $G(STR)'=1 S RESULTS="No Data." Q
104 .S RESULTS=$P($G(^TMP("DILIST",$J,1,0)),U,3)
105 .I RESULTS="" S RESULTS="No Data."
106 .K ^TMP("DILIST",$J),DIERR
107 S DATA=$$GET1^DIQ(FILE,IEN,FIELD)
108 I $G(DATA)'="" S RESULTS=DATA
109 Q
110GETINST(RESULTS) ;
111 ; RPC Call - Get Institutions from File 4
112 ; Output: RESULTS - global array
113 ;
114 ; 12/30/03 llh (OOPS*2*4) - this subroutine can only be used
115 ; to retrieve data from ^DIC(4). There is generic code in OOPSGUI3
116 ; to obtain data from other 'table files'.
117 ;
118 N ITEM,ROOT,X,XREF,SFLD,VAL,PTR,PCE,VALID,FIELD
119 K ^TMP("OOPSINST",$J)
120 S XREF="B",X=0,FIELD=13
121 S ROOT="^"_$$GET1^DID(2260,FIELD,"","POINTER")
122 S ITEM="" F S ITEM=$O(@(ROOT_"XREF,ITEM)")) Q:$G(ITEM)']"" D
123 .S PTR=0 F S PTR=$O(@(ROOT_"XREF,ITEM,PTR)")) Q:PTR="" D
124 ..I PTR'>0 Q
125 ..S VAL=$P(@(ROOT_PTR_",0)"),U)
126 ..S VALID=1,SFLD=ROOT_PTR_",99)"
127 ..I $P($G(@SFLD),U,4)=1 S VALID=0
128 ..I $P($G(@SFLD),U)'="" S VAL=VAL_" = "_$P($G(@SFLD),U)
129 ..I $P(VAL," = ")="" S VALID=0
130 ..I VALID S X=X+1,^TMP("OOPSINST",$J,X)=PTR_":"_VAL_$C(10)
131 S RESULTS=$NA(^TMP("OOPSINST",$J))
132 Q
133SENSDATA(RES,SDUZ,EMP) ;Supervisor accessed sensitive data, case not created
134 ; Input EMP String which is the name of the employee accessed.
135 ; DUZ DUZ of the Supervisor accessing the data.
136 N MGRP,MEMS,MSG
137 ;Make sure mail group exists
138 S MGRP=$$FIND1^DIC(3.8,"","X","OOPS ISO NOTIFICATION")
139 I 'MGRP D G BULL
140 .S XMY("G.OOPS WC MESSAGE")=""
141 .S XMDUZ="ASISTS Package"
142 .S GRP="OOPS WC MESSAGE"
143 .S XMSUB="ASISTS ISO NOTIFICATION Mail Group Error"
144 .S MSG(1)="The OOPS ISO NOTIFICATION Mail Group does not exist."
145 .S XMTEXT="MSG("
146 .D ^XMD
147 ;Make sure there is someone defined in the mail group
148 D LIST^DIC(3.81,","_MGRP_",","","",1,"","","","","","MEMS")
149 I '$P(MEMS("DILIST",0),U) D G BULL
150 .S XMY("G.OOPS WC MESSAGE")=""
151 .S XMDUZ="ASISTS Package"
152 .S GRP="OOPS WC MESSAGE"
153 .S XMSUB="ASISTS ISO NOTIFICATION Mail Group Error"
154 .S MSG(1)="There are no members in mail group OOPS ISO NOTIFICATION."
155 .S XMTEXT="MSG("
156 .D ^XMD
157 S XMY("G.OOPS ISO NOTIFICATION")=""
158BULL S (NAME,XMB)="OOPS SENSITIVE DATA"
159 S XMB(1)=$$GET1^DIQ(200,SDUZ,.01)
160 S XMB(2)=EMP
161 S XMB(3)=$$FMTE^XLFDT($$NOW^XLFDT,1)
162 S XMBODY="",XMINSTR("FLAGS")="X"
163 D TASKBULL^XMXAPI(DUZ,NAME,.XMB,XMBODY,.XMY,.XMINSTR)
164 K NAME,XMB,XMBODY,XMY,XMINSTR
165 S RES="BULLETIN SENT"
166 Q
Note: See TracBrowser for help on using the repository browser.