OOPSMBUL ;HIRMFO/REL-Bulletin ;3/30/98
;;2.0;ASISTS;**2,4,15**;Jun 03, 2002;Build 9
Q
MFAC ;
N NIEN,NGRP,TEST
S NIEN=$$GET1^DIQ(2260,IEN,13,"I")
S NGRP=GRP_" - "_$$GET1^DIQ(4,NIEN,99,"E")
S TEST=$$FIND1^DIC(3.8,"","AMX",NGRP)
I TEST S GRP=NGRP
D GRP
Q
CASE(IEN) ;
N CN,SUP,SUP2,Y,GRP
S XMB="OOPS CASE",X0=$G(^OOPS(2260,IEN,0)) K XMY
S CN=$P(X0,U,1),SUP=$P(X0,U,8),XMY(SUP)=""
S SUP2=$P(X0,U,9) I SUP2>0 S XMY(SUP2)=""
S XMB(3)=CN
; V2 - 05/09/02 LLH - add whether inj or illness
S XMB(6)=$$GET1^DIQ(2260,IEN,52)
; Patch 8 - added display of supervisors name to bulletin
S XMB(4)=$$GET1^DIQ(200,SUP,.01,"E")
I SUP2>0 S XMB(5)=$$GET1^DIQ(200,SUP2,.01,"E")
S Y=$P(X0,U,5) D DD^%DT S XMB(2)=Y
S Y=$P(X0,U,3)
S GRP="OOPS INJURY"
D MFAC
S GRP="OOPS UNION"
D MFAC
I $P(X0,U,4)>10 S GRP="OOPS EH" D MFAC
; next 2 lines restrict access to delivered message - 060303 LLH
S XMBODY="",XMINSTR("FLAGS")="IX"
D TASKBULL^XMXAPI(DUZ,"OOPS CASE",.XMB,XMBODY,.XMY,.XMINSTR)
Q
SAFETY(IEN) ; Safety Officer Bulletin
N GRP
S XMB="OOPS SAFETY",X0=$G(^OOPS(2260,IEN,0)) K XMY
S XMB(1)=$P(X0,U,2)
S XMB(3)=$P(X0,U,1)
S Y=$P(X0,U,5) D DD^%DT S XMB(2)=Y
S GRP="OOPS SAFETY"
D MFAC
D ^XMB K XMB,XMY,XMM,XMDT
Q
CIO(IEN) ; OOPS INCIDENT OUTCOME REQUIRED BULLETIN
;this bulletin is sent to the safety officer when the response to the
;INITIAL RETURN TO WORK STATUS (field #352) is "Days Away Work" or
;"Job Transfer/Transfer"
;Input: IEN of the ASISTS case
N GRP,XMB,X0
S XMB="OOPS INCIDENT OUTCOME REQUIRED",X0=$G(^OOPS(2260,IEN,0)) K XMY
S XMB(1)=$P(X0,U,1)
S GRP="OOPS SAFETY"
D MFAC
D ^XMB K XMB,XMY,XMM,XMDT
Q
CLSCASE(IEN) ; Bulletin to Safety & WC whenever a case is closed
; 01/02/04 Patch 4, llh
; Input
; IEN - Internal record number
;
N GRP
K XMB,XMY,X0
S XMB="OOPS CASE CLOSE NOTIFICATION"
S X0=$P($G(^OOPS(2260,IEN,0),"CASE UNDEFINED"),U)
S XMB(1)=X0 ; case number
S XMB(2)=$$GET1^DIQ(200,DUZ,.01,"E") ; name of user closing case
S XMB(3)=$$FMTE^XLFDT($$DT^XLFDT()) ; today's date
S GRP="OOPS WCP" D MFAC
D ^XMB
S GRP="OOPS SAFETY" D MFAC
D ^XMB K XMB,XMY,XMM,XMDT,X0
Q
WCPBOR(IEN) ; Employee does not understand bill of rights, sent msg to wcp
; Input
; IEN - Internal record number
;
N GRP,X0
S X0=$G(^OOPS(2260,IEN,0)) K XMY
S XMB(1)=$P(X0,U,2)
S XMB="OOPS WCPBOR"
S GRP="OOPS WCP"
D MFAC
D ^XMB K XMB,XMY,XMM,XMDT
Q
CONSENT(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
;
N GRP,X0,XA
S X0=$G(^OOPS(2260,IEN,0))
S XA=$G(^OOPS(2260,IEN,"2162A")) K XMY
S XMY(UNIREP)=""
S XMB(1)=$P(X0,U),Y=$P(X0,U,5) D DD^%DT S XMB(2)=Y
S XMB(3)=$$GET1^DIQ(2260,IEN,52)
S XMB(4)=$$GET1^DIQ(2260,IEN,2)
S XMB(5)=$$GET1^DIQ(2260,IEN,7)
S XMB(6)=$$GET1^DIQ(2260,IEN,13,"I")
S XMB(7)=$E($$GET1^DIQ(2260,IEN,18),1,28)
S XMB(8)=$$GET1^DIQ(2260,IEN,14)
S XMB(9)=$P(XA,U,12)_"/"_$P(XA,U,13)
S XMB(10)=$E($$GET1^DIQ(2260,IEN,53),1,23)
S XMB(11)=$E($$GET1^DIQ(2260,IEN,53.1),1,28)
S XMB(12)=$E($$GET1^DIQ(2260,IEN,3),1,23)
S XMDUZ=.5
S XMB="OOPS CONSENT"
D ^XMB K XMB,XMY,XMM,XMDT,XMDUZ
Q
WCP(IEN,ACT) ; Bulletin to Super when WC edits or WX signs CA1/CA2
; Input
; IEN - Internal record number
; ACT -
; "E" = Edited by the WC personnel
; "S" = Signed by the WC personnel
;
N SUP,SUP2,Y
S XMB=$S(ACT="E":"OOPS WC EDITED",ACT="S":"OOPS WC SIGNED",1:"")
I $G(XMB)="" Q
S X0=$G(^OOPS(2260,IEN,0)) K XMY
S SUP=$P(X0,U,8),XMY(SUP)=""
S SUP2=$P(X0,U,9) I $G(SUP2) S XMY(SUP2)=""
S XMB(1)=$P(X0,U,2)
S XMB(2)=$P(X0,U,1)
S Y=$P(X0,U,5) D DD^%DT S XMB(3)=Y
S XMDUZ=.5
D ^XMB K XMB,XMY,XMM,XMDT,X0,XMDUZ
Q
SUPS(IEN) ; Bulletin to WC when Supervisor signs CA1/CA2
; Patch 8
N SUP,SUP2,FORM,GRP,Y
S XMB="OOPS WORKERS COMP",X0=$G(^OOPS(2260,IEN,0)) K XMY
S SUP=$P(X0,U,8),XMY(SUP)=""
S SUP2=$P(X0,U,9) I $G(SUP2) S XMY(SUP2)=""
S XMB(1)=$P(X0,U,2)
S XMB(2)=$P(X0,U,1)
S Y=$P(X0,U,5) D DD^%DT S XMB(3)=Y
S FORM=$P(X0,U,7)
S FORM=$S(FORM=1:"CA1ES",FORM=2:"CA2ES",1:"")
I FORM="" Q
S Y=$P(^OOPS(2260,IEN,FORM),U,6) D DD^%DT S XMB(4)=Y
S GRP="OOPS WCP"
D MFAC
D ^XMB K XMB,XMY,XMM,XMDT,X0
Q
UNION(IEN) ; Union Bulletin
N GRP,Y
S XMB="OOPS SUPERVISOR",X0=$G(^OOPS(2260,IEN,0)) K XMY
S XMB(3)=$P(X0,U,1)
S Y=$P(X0,U,5) D DD^%DT S XMB(2)=Y
S GRP="OOPS UNION"
D MFAC
D ^XMB K XMB,XMY,XMM,XMDT
Q
EMP(IEN) ; Employee notification to supervisor
N GRP,SUP,SUP2
S XMB="OOPS EMPLOYEE",X0=$G(^OOPS(2260,IEN,0)) K XMY
S XMB(3)=$P(X0,U,1)
S Y=$P(X0,U,5) D DD^%DT S XMB(2)=Y
S SUP=$P(X0,U,8),XMY(SUP)=""
S SUP2=$P(X0,U,9) I SUP2>0 S XMY(SUP2)=""
S GRP="OOPS INJURY"
D MFAC
D ^XMB K XMY,XMM,XMDT
S GRP="OOPS UNION"
D MFAC
S XMDUZ=.5
D ^XMB K XMB,XMY,XMM,XMDT,XMDUZ
Q
BOR(IEN) ; Employee Bill of Rights
N EMP
S XMB="OOPS BILL OF RIGHTS" K XMY
S EMP=$O(^VA(200,"SSN",SSN,0)),XMY(EMP)=""
D ^XMB K XMB,XMY,XMM,XMDT
Q
GRP ; Get Mail group Members for GRP
I GRP="" Q
S XMY("I:G."_GRP)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOOPSMBUL 5269 printed Dec 13, 2024@01:39:16 Page 2
OOPSMBUL ;HIRMFO/REL-Bulletin ;3/30/98
+1 ;;2.0;ASISTS;**2,4,15**;Jun 03, 2002;Build 9
+2 QUIT
MFAC ;
+1 NEW NIEN,NGRP,TEST
+2 SET NIEN=$$GET1^DIQ(2260,IEN,13,"I")
+3 SET NGRP=GRP_" - "_$$GET1^DIQ(4,NIEN,99,"E")
+4 SET TEST=$$FIND1^DIC(3.8,"","AMX",NGRP)
+5 IF TEST
SET GRP=NGRP
+6 DO GRP
+7 QUIT
CASE(IEN) ;
+1 NEW CN,SUP,SUP2,Y,GRP
+2 SET XMB="OOPS CASE"
SET X0=$GET(^OOPS(2260,IEN,0))
KILL XMY
+3 SET CN=$PIECE(X0,U,1)
SET SUP=$PIECE(X0,U,8)
SET XMY(SUP)=""
+4 SET SUP2=$PIECE(X0,U,9)
IF SUP2>0
SET XMY(SUP2)=""
+5 SET XMB(3)=CN
+6 ; V2 - 05/09/02 LLH - add whether inj or illness
+7 SET XMB(6)=$$GET1^DIQ(2260,IEN,52)
+8 ; Patch 8 - added display of supervisors name to bulletin
+9 SET XMB(4)=$$GET1^DIQ(200,SUP,.01,"E")
+10 IF SUP2>0
SET XMB(5)=$$GET1^DIQ(200,SUP2,.01,"E")
+11 SET Y=$PIECE(X0,U,5)
DO DD^%DT
SET XMB(2)=Y
+12 SET Y=$PIECE(X0,U,3)
+13 SET GRP="OOPS INJURY"
+14 DO MFAC
+15 SET GRP="OOPS UNION"
+16 DO MFAC
+17 IF $PIECE(X0,U,4)>10
SET GRP="OOPS EH"
DO MFAC
+18 ; next 2 lines restrict access to delivered message - 060303 LLH
+19 SET XMBODY=""
SET XMINSTR("FLAGS")="IX"
+20 DO TASKBULL^XMXAPI(DUZ,"OOPS CASE",.XMB,XMBODY,.XMY,.XMINSTR)
+21 QUIT
SAFETY(IEN) ; Safety Officer Bulletin
+1 NEW GRP
+2 SET XMB="OOPS SAFETY"
SET X0=$GET(^OOPS(2260,IEN,0))
KILL XMY
+3 SET XMB(1)=$PIECE(X0,U,2)
+4 SET XMB(3)=$PIECE(X0,U,1)
+5 SET Y=$PIECE(X0,U,5)
DO DD^%DT
SET XMB(2)=Y
+6 SET GRP="OOPS SAFETY"
+7 DO MFAC
+8 DO ^XMB
KILL XMB,XMY,XMM,XMDT
+9 QUIT
CIO(IEN) ; OOPS INCIDENT OUTCOME REQUIRED BULLETIN
+1 ;this bulletin is sent to the safety officer when the response to the
+2 ;INITIAL RETURN TO WORK STATUS (field #352) is "Days Away Work" or
+3 ;"Job Transfer/Transfer"
+4 ;Input: IEN of the ASISTS case
+5 NEW GRP,XMB,X0
+6 SET XMB="OOPS INCIDENT OUTCOME REQUIRED"
SET X0=$GET(^OOPS(2260,IEN,0))
KILL XMY
+7 SET XMB(1)=$PIECE(X0,U,1)
+8 SET GRP="OOPS SAFETY"
+9 DO MFAC
+10 DO ^XMB
KILL XMB,XMY,XMM,XMDT
+11 QUIT
CLSCASE(IEN) ; Bulletin to Safety & WC whenever a case is closed
+1 ; 01/02/04 Patch 4, llh
+2 ; Input
+3 ; IEN - Internal record number
+4 ;
+5 NEW GRP
+6 KILL XMB,XMY,X0
+7 SET XMB="OOPS CASE CLOSE NOTIFICATION"
+8 SET X0=$PIECE($GET(^OOPS(2260,IEN,0),"CASE UNDEFINED"),U)
+9 ; case number
SET XMB(1)=X0
+10 ; name of user closing case
SET XMB(2)=$$GET1^DIQ(200,DUZ,.01,"E")
+11 ; today's date
SET XMB(3)=$$FMTE^XLFDT($$DT^XLFDT())
+12 SET GRP="OOPS WCP"
DO MFAC
+13 DO ^XMB
+14 SET GRP="OOPS SAFETY"
DO MFAC
+15 DO ^XMB
KILL XMB,XMY,XMM,XMDT,X0
+16 QUIT
WCPBOR(IEN) ; Employee does not understand bill of rights, sent msg to wcp
+1 ; Input
+2 ; IEN - Internal record number
+3 ;
+4 NEW GRP,X0
+5 SET X0=$GET(^OOPS(2260,IEN,0))
KILL XMY
+6 SET XMB(1)=$PIECE(X0,U,2)
+7 SET XMB="OOPS WCPBOR"
+8 SET GRP="OOPS WCP"
+9 DO MFAC
+10 DO ^XMB
KILL XMB,XMY,XMM,XMDT
+11 QUIT
CONSENT(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 ;
+6 NEW GRP,X0,XA
+7 SET X0=$GET(^OOPS(2260,IEN,0))
+8 SET XA=$GET(^OOPS(2260,IEN,"2162A"))
KILL XMY
+9 SET XMY(UNIREP)=""
+10 SET XMB(1)=$PIECE(X0,U)
SET Y=$PIECE(X0,U,5)
DO DD^%DT
SET XMB(2)=Y
+11 SET XMB(3)=$$GET1^DIQ(2260,IEN,52)
+12 SET XMB(4)=$$GET1^DIQ(2260,IEN,2)
+13 SET XMB(5)=$$GET1^DIQ(2260,IEN,7)
+14 SET XMB(6)=$$GET1^DIQ(2260,IEN,13,"I")
+15 SET XMB(7)=$EXTRACT($$GET1^DIQ(2260,IEN,18),1,28)
+16 SET XMB(8)=$$GET1^DIQ(2260,IEN,14)
+17 SET XMB(9)=$PIECE(XA,U,12)_"/"_$PIECE(XA,U,13)
+18 SET XMB(10)=$EXTRACT($$GET1^DIQ(2260,IEN,53),1,23)
+19 SET XMB(11)=$EXTRACT($$GET1^DIQ(2260,IEN,53.1),1,28)
+20 SET XMB(12)=$EXTRACT($$GET1^DIQ(2260,IEN,3),1,23)
+21 SET XMDUZ=.5
+22 SET XMB="OOPS CONSENT"
+23 DO ^XMB
KILL XMB,XMY,XMM,XMDT,XMDUZ
+24 QUIT
WCP(IEN,ACT) ; Bulletin to Super when WC edits or WX signs CA1/CA2
+1 ; Input
+2 ; IEN - Internal record number
+3 ; ACT -
+4 ; "E" = Edited by the WC personnel
+5 ; "S" = Signed by the WC personnel
+6 ;
+7 NEW SUP,SUP2,Y
+8 SET XMB=$SELECT(ACT="E":"OOPS WC EDITED",ACT="S":"OOPS WC SIGNED",1:"")
+9 IF $GET(XMB)=""
QUIT
+10 SET X0=$GET(^OOPS(2260,IEN,0))
KILL XMY
+11 SET SUP=$PIECE(X0,U,8)
SET XMY(SUP)=""
+12 SET SUP2=$PIECE(X0,U,9)
IF $GET(SUP2)
SET XMY(SUP2)=""
+13 SET XMB(1)=$PIECE(X0,U,2)
+14 SET XMB(2)=$PIECE(X0,U,1)
+15 SET Y=$PIECE(X0,U,5)
DO DD^%DT
SET XMB(3)=Y
+16 SET XMDUZ=.5
+17 DO ^XMB
KILL XMB,XMY,XMM,XMDT,X0,XMDUZ
+18 QUIT
SUPS(IEN) ; Bulletin to WC when Supervisor signs CA1/CA2
+1 ; Patch 8
+2 NEW SUP,SUP2,FORM,GRP,Y
+3 SET XMB="OOPS WORKERS COMP"
SET X0=$GET(^OOPS(2260,IEN,0))
KILL XMY
+4 SET SUP=$PIECE(X0,U,8)
SET XMY(SUP)=""
+5 SET SUP2=$PIECE(X0,U,9)
IF $GET(SUP2)
SET XMY(SUP2)=""
+6 SET XMB(1)=$PIECE(X0,U,2)
+7 SET XMB(2)=$PIECE(X0,U,1)
+8 SET Y=$PIECE(X0,U,5)
DO DD^%DT
SET XMB(3)=Y
+9 SET FORM=$PIECE(X0,U,7)
+10 SET FORM=$SELECT(FORM=1:"CA1ES",FORM=2:"CA2ES",1:"")
+11 IF FORM=""
QUIT
+12 SET Y=$PIECE(^OOPS(2260,IEN,FORM),U,6)
DO DD^%DT
SET XMB(4)=Y
+13 SET GRP="OOPS WCP"
+14 DO MFAC
+15 DO ^XMB
KILL XMB,XMY,XMM,XMDT,X0
+16 QUIT
UNION(IEN) ; Union Bulletin
+1 NEW GRP,Y
+2 SET XMB="OOPS SUPERVISOR"
SET X0=$GET(^OOPS(2260,IEN,0))
KILL XMY
+3 SET XMB(3)=$PIECE(X0,U,1)
+4 SET Y=$PIECE(X0,U,5)
DO DD^%DT
SET XMB(2)=Y
+5 SET GRP="OOPS UNION"
+6 DO MFAC
+7 DO ^XMB
KILL XMB,XMY,XMM,XMDT
+8 QUIT
EMP(IEN) ; Employee notification to supervisor
+1 NEW GRP,SUP,SUP2
+2 SET XMB="OOPS EMPLOYEE"
SET X0=$GET(^OOPS(2260,IEN,0))
KILL XMY
+3 SET XMB(3)=$PIECE(X0,U,1)
+4 SET Y=$PIECE(X0,U,5)
DO DD^%DT
SET XMB(2)=Y
+5 SET SUP=$PIECE(X0,U,8)
SET XMY(SUP)=""
+6 SET SUP2=$PIECE(X0,U,9)
IF SUP2>0
SET XMY(SUP2)=""
+7 SET GRP="OOPS INJURY"
+8 DO MFAC
+9 DO ^XMB
KILL XMY,XMM,XMDT
+10 SET GRP="OOPS UNION"
+11 DO MFAC
+12 SET XMDUZ=.5
+13 DO ^XMB
KILL XMB,XMY,XMM,XMDT,XMDUZ
+14 QUIT
BOR(IEN) ; Employee Bill of Rights
+1 NEW EMP
+2 SET XMB="OOPS BILL OF RIGHTS"
KILL XMY
+3 SET EMP=$ORDER(^VA(200,"SSN",SSN,0))
SET XMY(EMP)=""
+4 DO ^XMB
KILL XMB,XMY,XMM,XMDT
+5 QUIT
GRP ; Get Mail group Members for GRP
+1 IF GRP=""
QUIT
+2 SET XMY("I:G."_GRP)=""
+3 QUIT