- 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 Feb 18, 2025@23:05:39 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