OOPSGUI7 ;WIOFO/LLH-RPC routines ;10/30/01
;;2.0;ASISTS;**2,4,7,22**;Jun 03, 2002;Build 1
;
ENT(RESULTS,INPUT) ; Non-interactive GUI Entry Point for transmitting data
; to DOL or NDB
; Input: INPUT - Contains the date for the claims to be
; retransmitted, the queue date and time for the
; retransmission date to run and either DOL or NDB
; to indicate which manual transmission should run.
; The format is TRANSDT^QUEUEDT@TIME^DOL (or NDB)
; Output: RESULTS - is the return array to the client with status
; message
N ARR,COMMA,ERR1,ERR2,FIELD,FL,MAILG,CURR,QDATE,QUE,RDATE,RTN,X,Y
N MAN,WOK,ZTDESC,ZTREQ,ZTRTN
S RTN=$P($G(INPUT),U,3)
S MAN=1 ; force manual xmit flag
I RTN="DOL" D
. S MAILG="OOPS DOL XMIT DATA"
. S QUE="Q-AST.DOMAIN.EXT"
I RTN="NDB" D
. S MAILG="OOPS XMIT 2162 DATA"
. S QUE="Q-ASI.DOMAIN.EXT"
;Check for security keys
I '$D(^XUSEC(MAILG,DUZ)) D Q
.S RESULTS(0)="ERROR"
.S RESULTS(1)="You do not have the required Security Key."
;Assure the Queue has been defined
S FIELD=.01,FL="X"
D FIND^DIC(4.2,"",FIELD,FL,QUE,"","","","","ARR")
I '$D(ARR("DILIST",1)) D Q
.S RESULTS(0)="ERROR"
.S RESULTS(1)="Domain not found in the DOMAIN File,"
; Get Retransmit Date from First Piece of Input & Translate into FM
S X=$P($G(INPUT),U) D ^%DT
S RDATE=Y
I RDATE=-1 S ERR1=1
S %DT="R",X=$P($G(INPUT),U,2) D ^%DT K %DT
S QDATE=Y
I QDATE=-1 S ERR2=2
I $G(ERR1)!($G(ERR2)) D Q
. S RESULTS(0)="ERROR",RESULTS(1)="",COMMA=""
. S:$G(ERR1) RESULTS(1)="Invalid Transmission Date",COMMA=", "
. S:$G(ERR2) RESULTS(1)=RESULTS(1)_COMMA_"Invalid Queue Date."
;
I RTN="DOL" D
. S ZTRTN="EN^OOPSDOL",WOK=1,ZTDESC="TRANSMIT DOL CA1/CA2 DATA"
I RTN="NDB" D
. S ZTRTN="EN^OOPSNDB",ZTDESC="TRANSMIT NATIONAL DATABASE 2162 DATA"
; Make sure Queue date/time is not after current time
S CURR=$$HTFM^XLFDT(""_$H_"")
I $$FMDIFF^XLFDT(QDATE,CURR,2)<0 S QDATE=$H
; Report will always be Queued from the GUI
K IO("Q"),ZTUCI,ZTDTH,ZTIO,ZTSAVE
S ZTDTH=QDATE,ZTIO="",ZTREQ="@",ZTSAVE("ZTREQ")=""
S ZTSAVE("RDATE")="",ZTSAVE("MAN")=""
D ^%ZTLOAD
K ZTSK
S RESULTS(0)="SUCCESSFULLY QUEUED"
Q
OWCPCLR(RESULTS,IEN,CALLER,FORM) ; Entry point for clearing supervisor
; fields if OWPC worker has edited them
; Input: IEN - ien of case to have the fields cleared
; CALLER - menu being called from
; FORM - whether a CA1 or CA2
; Output: RESULTS - required results parameter, no data returned
; from this call
I $G(IEN)=""!($G(CALLER)="")!($G(FORM)="") Q
D CLRFLDS^OOPSWCE
SUPFLDS ; Clear Supervisor fields for the CA1, since fields have been changed
I FORM'="CA1" Q
N SUP
S SUP=$$GET1^DIQ(200,DUZ,.01)
S RESULTS=SUP
S $P(^OOPS(2260,IEN,"CA1L"),U,3)="" ;Clear EXCEPTION
S $P(^OOPS(2260,IEN,"CA1L"),U,4)="" ;Clear SUP TITLE
S $P(^OOPS(2260,IEN,"CA1L"),U,5)="" ;Clear SUP PHONE
Q
CONSENT(RESULTS,IEN,UNIREP) ; Employee consented to union notification,
; send msg to union
; Input
; IEN - Internal record number
; UNIREP - IEN from file 200 of the Union Rep - used to send bulletin
; Output - RESULTS - String indicating bulletin status.
D CONSENT^OOPSMBUL(IEN,UNIREP)
Q
GETFLD(RESULTS,IEN,FLD) ; Send in IEN and Field number to retrieve a single
; data field from the ASISTS Accident Reporting File (#2260)
;
; Input: IEN - Internal record number
; Output: FLD - the file and field number of the data element to be
; retrieved. EX. 2260^120
N FILE,FIELD,DATA
S RESULTS="No data."
I '$G(IEN) S RESULTS="No data. Missing Record Identifier." Q
S FILE=$P(FLD,U),FIELD=$P(FLD,U,2)
I $G(FILE)=""!($G(FIELD)="") D Q
. S RESULTS="No data. Missing File or Field information."
; This should only get called when OOPS*2.0*7 is 1st released, used
; to get hire date if it's blank and personnel status is employee
I FIELD=336 D Q
.N SSN,STR S SSN=$$GET1^DIQ(FILE,IEN,5,"I")
.D FIND^DIC(450,,"@;.01;30","PS",SSN,"","SSN")
.S STR=$P($G(^TMP("DILIST",$J,0)),U) I $G(STR)'=1 S RESULTS="No Data." Q
.S RESULTS=$P($G(^TMP("DILIST",$J,1,0)),U,3)
.I RESULTS="" S RESULTS="No Data."
.K ^TMP("DILIST",$J),DIERR
S DATA=$$GET1^DIQ(FILE,IEN,FIELD)
I $G(DATA)'="" S RESULTS=DATA
Q
GETINST(RESULTS) ;
; RPC Call - Get Institutions from File 4
; Output: RESULTS - global array
;
; 12/30/03 llh (OOPS*2*4) - this subroutine can only be used
; to retrieve data from ^DIC(4). There is generic code in OOPSGUI3
; to obtain data from other 'table files'.
;
N ITEM,ROOT,X,XREF,SFLD,VAL,PTR,PCE,VALID,FIELD
K ^TMP("OOPSINST",$J)
S XREF="B",X=0,FIELD=13
S ROOT="^"_$$GET1^DID(2260,FIELD,"","POINTER")
S ITEM="" F S ITEM=$O(@(ROOT_"XREF,ITEM)")) Q:$G(ITEM)']"" D
.S PTR=0 F S PTR=$O(@(ROOT_"XREF,ITEM,PTR)")) Q:PTR="" D
..I PTR'>0 Q
..S VAL=$P(@(ROOT_PTR_",0)"),U)
..S VALID=1,SFLD=ROOT_PTR_",99)"
..I $P($G(@SFLD),U,4)=1 S VALID=0
..I $P($G(@SFLD),U)'="" S VAL=VAL_" = "_$P($G(@SFLD),U)
..I $P(VAL," = ")="" S VALID=0
..I VALID S X=X+1,^TMP("OOPSINST",$J,X)=PTR_":"_VAL_$C(10)
S RESULTS=$NA(^TMP("OOPSINST",$J))
Q
SENSDATA(RES,SDUZ,EMP) ;Supervisor accessed sensitive data, case not created
; Input EMP String which is the name of the employee accessed.
; DUZ DUZ of the Supervisor accessing the data.
N MGRP,MEMS,MSG
;Make sure mail group exists
S MGRP=$$FIND1^DIC(3.8,"","X","OOPS ISO NOTIFICATION")
I 'MGRP D G BULL
.S XMY("G.OOPS WC MESSAGE")=""
.S XMDUZ="ASISTS Package"
.S GRP="OOPS WC MESSAGE"
.S XMSUB="ASISTS ISO NOTIFICATION Mail Group Error"
.S MSG(1)="The OOPS ISO NOTIFICATION Mail Group does not exist."
.S XMTEXT="MSG("
.D ^XMD
;Make sure there is someone defined in the mail group
D LIST^DIC(3.81,","_MGRP_",","","",1,"","","","","","MEMS")
I '$P(MEMS("DILIST",0),U) D G BULL
.S XMY("G.OOPS WC MESSAGE")=""
.S XMDUZ="ASISTS Package"
.S GRP="OOPS WC MESSAGE"
.S XMSUB="ASISTS ISO NOTIFICATION Mail Group Error"
.S MSG(1)="There are no members in mail group OOPS ISO NOTIFICATION."
.S XMTEXT="MSG("
.D ^XMD
S XMY("G.OOPS ISO NOTIFICATION")=""
BULL S (NAME,XMB)="OOPS SENSITIVE DATA"
S XMB(1)=$$GET1^DIQ(200,SDUZ,.01)
S XMB(2)=EMP
S XMB(3)=$$FMTE^XLFDT($$NOW^XLFDT,1)
S XMBODY="",XMINSTR("FLAGS")="X"
D TASKBULL^XMXAPI(DUZ,NAME,.XMB,XMBODY,.XMY,.XMINSTR)
K NAME,XMB,XMBODY,XMY,XMINSTR
S RES="BULLETIN SENT"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOOPSGUI7 6645 printed Nov 22, 2024@16:49:18 Page 2
OOPSGUI7 ;WIOFO/LLH-RPC routines ;10/30/01
+1 ;;2.0;ASISTS;**2,4,7,22**;Jun 03, 2002;Build 1
+2 ;
ENT(RESULTS,INPUT) ; Non-interactive GUI Entry Point for transmitting data
+1 ; to DOL or NDB
+2 ; Input: INPUT - Contains the date for the claims to be
+3 ; retransmitted, the queue date and time for the
+4 ; retransmission date to run and either DOL or NDB
+5 ; to indicate which manual transmission should run.
+6 ; The format is TRANSDT^QUEUEDT@TIME^DOL (or NDB)
+7 ; Output: RESULTS - is the return array to the client with status
+8 ; message
+9 NEW ARR,COMMA,ERR1,ERR2,FIELD,FL,MAILG,CURR,QDATE,QUE,RDATE,RTN,X,Y
+10 NEW MAN,WOK,ZTDESC,ZTREQ,ZTRTN
+11 SET RTN=$PIECE($GET(INPUT),U,3)
+12 ; force manual xmit flag
SET MAN=1
+13 IF RTN="DOL"
Begin DoDot:1
+14 SET MAILG="OOPS DOL XMIT DATA"
+15 SET QUE="Q-AST.DOMAIN.EXT"
End DoDot:1
+16 IF RTN="NDB"
Begin DoDot:1
+17 SET MAILG="OOPS XMIT 2162 DATA"
+18 SET QUE="Q-ASI.DOMAIN.EXT"
End DoDot:1
+19 ;Check for security keys
+20 IF '$DATA(^XUSEC(MAILG,DUZ))
Begin DoDot:1
+21 SET RESULTS(0)="ERROR"
+22 SET RESULTS(1)="You do not have the required Security Key."
End DoDot:1
QUIT
+23 ;Assure the Queue has been defined
+24 SET FIELD=.01
SET FL="X"
+25 DO FIND^DIC(4.2,"",FIELD,FL,QUE,"","","","","ARR")
+26 IF '$DATA(ARR("DILIST",1))
Begin DoDot:1
+27 SET RESULTS(0)="ERROR"
+28 SET RESULTS(1)="Domain not found in the DOMAIN File,"
End DoDot:1
QUIT
+29 ; Get Retransmit Date from First Piece of Input & Translate into FM
+30 SET X=$PIECE($GET(INPUT),U)
DO ^%DT
+31 SET RDATE=Y
+32 IF RDATE=-1
SET ERR1=1
+33 SET %DT="R"
SET X=$PIECE($GET(INPUT),U,2)
DO ^%DT
KILL %DT
+34 SET QDATE=Y
+35 IF QDATE=-1
SET ERR2=2
+36 IF $GET(ERR1)!($GET(ERR2))
Begin DoDot:1
+37 SET RESULTS(0)="ERROR"
SET RESULTS(1)=""
SET COMMA=""
+38 if $GET(ERR1)
SET RESULTS(1)="Invalid Transmission Date"
SET COMMA=", "
+39 if $GET(ERR2)
SET RESULTS(1)=RESULTS(1)_COMMA_"Invalid Queue Date."
End DoDot:1
QUIT
+40 ;
+41 IF RTN="DOL"
Begin DoDot:1
+42 SET ZTRTN="EN^OOPSDOL"
SET WOK=1
SET ZTDESC="TRANSMIT DOL CA1/CA2 DATA"
End DoDot:1
+43 IF RTN="NDB"
Begin DoDot:1
+44 SET ZTRTN="EN^OOPSNDB"
SET ZTDESC="TRANSMIT NATIONAL DATABASE 2162 DATA"
End DoDot:1
+45 ; Make sure Queue date/time is not after current time
+46 SET CURR=$$HTFM^XLFDT(""_$HOROLOG_"")
+47 IF $$FMDIFF^XLFDT(QDATE,CURR,2)<0
SET QDATE=$HOROLOG
+48 ; Report will always be Queued from the GUI
+49 KILL IO("Q"),ZTUCI,ZTDTH,ZTIO,ZTSAVE
+50 SET ZTDTH=QDATE
SET ZTIO=""
SET ZTREQ="@"
SET ZTSAVE("ZTREQ")=""
+51 SET ZTSAVE("RDATE")=""
SET ZTSAVE("MAN")=""
+52 DO ^%ZTLOAD
+53 KILL ZTSK
+54 SET RESULTS(0)="SUCCESSFULLY QUEUED"
+55 QUIT
OWCPCLR(RESULTS,IEN,CALLER,FORM) ; Entry point for clearing supervisor
+1 ; fields if OWPC worker has edited them
+2 ; Input: IEN - ien of case to have the fields cleared
+3 ; CALLER - menu being called from
+4 ; FORM - whether a CA1 or CA2
+5 ; Output: RESULTS - required results parameter, no data returned
+6 ; from this call
+7 IF $GET(IEN)=""!($GET(CALLER)="")!($GET(FORM)="")
QUIT
+8 DO CLRFLDS^OOPSWCE
SUPFLDS ; Clear Supervisor fields for the CA1, since fields have been changed
+1 IF FORM'="CA1"
QUIT
+2 NEW SUP
+3 SET SUP=$$GET1^DIQ(200,DUZ,.01)
+4 SET RESULTS=SUP
+5 ;Clear EXCEPTION
SET $PIECE(^OOPS(2260,IEN,"CA1L"),U,3)=""
+6 ;Clear SUP TITLE
SET $PIECE(^OOPS(2260,IEN,"CA1L"),U,4)=""
+7 ;Clear SUP PHONE
SET $PIECE(^OOPS(2260,IEN,"CA1L"),U,5)=""
+8 QUIT
CONSENT(RESULTS,IEN,UNIREP) ; Employee consented to union notification,
+1 ; send msg to union
+2 ; Input
+3 ; IEN - Internal record number
+4 ; UNIREP - IEN from file 200 of the Union Rep - used to send bulletin
+5 ; Output - RESULTS - String indicating bulletin status.
+6 DO CONSENT^OOPSMBUL(IEN,UNIREP)
+7 QUIT
GETFLD(RESULTS,IEN,FLD) ; Send in IEN and Field number to retrieve a single
+1 ; data field from the ASISTS Accident Reporting File (#2260)
+2 ;
+3 ; Input: IEN - Internal record number
+4 ; Output: FLD - the file and field number of the data element to be
+5 ; retrieved. EX. 2260^120
+6 NEW FILE,FIELD,DATA
+7 SET RESULTS="No data."
+8 IF '$GET(IEN)
SET RESULTS="No data. Missing Record Identifier."
QUIT
+9 SET FILE=$PIECE(FLD,U)
SET FIELD=$PIECE(FLD,U,2)
+10 IF $GET(FILE)=""!($GET(FIELD)="")
Begin DoDot:1
+11 SET RESULTS="No data. Missing File or Field information."
End DoDot:1
QUIT
+12 ; This should only get called when OOPS*2.0*7 is 1st released, used
+13 ; to get hire date if it's blank and personnel status is employee
+14 IF FIELD=336
Begin DoDot:1
+15 NEW SSN,STR
SET SSN=$$GET1^DIQ(FILE,IEN,5,"I")
+16 DO FIND^DIC(450,,"@;.01;30","PS",SSN,"","SSN")
+17 SET STR=$PIECE($GET(^TMP("DILIST",$JOB,0)),U)
IF $GET(STR)'=1
SET RESULTS="No Data."
QUIT
+18 SET RESULTS=$PIECE($GET(^TMP("DILIST",$JOB,1,0)),U,3)
+19 IF RESULTS=""
SET RESULTS="No Data."
+20 KILL ^TMP("DILIST",$JOB),DIERR
End DoDot:1
QUIT
+21 SET DATA=$$GET1^DIQ(FILE,IEN,FIELD)
+22 IF $GET(DATA)'=""
SET RESULTS=DATA
+23 QUIT
GETINST(RESULTS) ;
+1 ; RPC Call - Get Institutions from File 4
+2 ; Output: RESULTS - global array
+3 ;
+4 ; 12/30/03 llh (OOPS*2*4) - this subroutine can only be used
+5 ; to retrieve data from ^DIC(4). There is generic code in OOPSGUI3
+6 ; to obtain data from other 'table files'.
+7 ;
+8 NEW ITEM,ROOT,X,XREF,SFLD,VAL,PTR,PCE,VALID,FIELD
+9 KILL ^TMP("OOPSINST",$JOB)
+10 SET XREF="B"
SET X=0
SET FIELD=13
+11 SET ROOT="^"_$$GET1^DID(2260,FIELD,"","POINTER")
+12 SET ITEM=""
FOR
SET ITEM=$ORDER(@(ROOT_"XREF,ITEM)"))
if $GET(ITEM)']""
QUIT
Begin DoDot:1
+13 SET PTR=0
FOR
SET PTR=$ORDER(@(ROOT_"XREF,ITEM,PTR)"))
if PTR=""
QUIT
Begin DoDot:2
+14 IF PTR'>0
QUIT
+15 SET VAL=$PIECE(@(ROOT_PTR_",0)"),U)
+16 SET VALID=1
SET SFLD=ROOT_PTR_",99)"
+17 IF $PIECE($GET(@SFLD),U,4)=1
SET VALID=0
+18 IF $PIECE($GET(@SFLD),U)'=""
SET VAL=VAL_" = "_$PIECE($GET(@SFLD),U)
+19 IF $PIECE(VAL," = ")=""
SET VALID=0
+20 IF VALID
SET X=X+1
SET ^TMP("OOPSINST",$JOB,X)=PTR_":"_VAL_$CHAR(10)
End DoDot:2
End DoDot:1
+21 SET RESULTS=$NAME(^TMP("OOPSINST",$JOB))
+22 QUIT
SENSDATA(RES,SDUZ,EMP) ;Supervisor accessed sensitive data, case not created
+1 ; Input EMP String which is the name of the employee accessed.
+2 ; DUZ DUZ of the Supervisor accessing the data.
+3 NEW MGRP,MEMS,MSG
+4 ;Make sure mail group exists
+5 SET MGRP=$$FIND1^DIC(3.8,"","X","OOPS ISO NOTIFICATION")
+6 IF 'MGRP
Begin DoDot:1
+7 SET XMY("G.OOPS WC MESSAGE")=""
+8 SET XMDUZ="ASISTS Package"
+9 SET GRP="OOPS WC MESSAGE"
+10 SET XMSUB="ASISTS ISO NOTIFICATION Mail Group Error"
+11 SET MSG(1)="The OOPS ISO NOTIFICATION Mail Group does not exist."
+12 SET XMTEXT="MSG("
+13 DO ^XMD
End DoDot:1
GOTO BULL
+14 ;Make sure there is someone defined in the mail group
+15 DO LIST^DIC(3.81,","_MGRP_",","","",1,"","","","","","MEMS")
+16 IF '$PIECE(MEMS("DILIST",0),U)
Begin DoDot:1
+17 SET XMY("G.OOPS WC MESSAGE")=""
+18 SET XMDUZ="ASISTS Package"
+19 SET GRP="OOPS WC MESSAGE"
+20 SET XMSUB="ASISTS ISO NOTIFICATION Mail Group Error"
+21 SET MSG(1)="There are no members in mail group OOPS ISO NOTIFICATION."
+22 SET XMTEXT="MSG("
+23 DO ^XMD
End DoDot:1
GOTO BULL
+24 SET XMY("G.OOPS ISO NOTIFICATION")=""
BULL SET (NAME,XMB)="OOPS SENSITIVE DATA"
+1 SET XMB(1)=$$GET1^DIQ(200,SDUZ,.01)
+2 SET XMB(2)=EMP
+3 SET XMB(3)=$$FMTE^XLFDT($$NOW^XLFDT,1)
+4 SET XMBODY=""
SET XMINSTR("FLAGS")="X"
+5 DO TASKBULL^XMXAPI(DUZ,NAME,.XMB,XMBODY,.XMY,.XMINSTR)
+6 KILL NAME,XMB,XMBODY,XMY,XMINSTR
+7 SET RES="BULLETIN SENT"
+8 QUIT
