Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: OOPSWCE

OOPSWCE.m

Go to the documentation of this file. 
  1. OOPSWCE ;WIOFO/LLH-Workers Comp Edit routine ;3/23/00
  1.  ;;2.0;ASISTS;;Jun 03, 2002
  1.  ;;
  1. EN1(CALLER) ;  Main Entry Point
  1.  N CA,CASIGN,DIC,DONE,FORM,IEN,OOPS,OUT,SIGN,SSN,SUP,X,WOK,WCPDO
  1.  S (DONE,OUT,IEN)=0
  1.  S WOK=1                            ; to set cross reference
  1.  Q:DUZ<1
  1.  Q:$G(^VA(200,DUZ,1))=""
  1.  ;  Select a Case
  1.  S DIC="^OOPS(2260,"
  1.  S DIC("S")="I $$WC^OOPSWCE(Y)"
  1.  S DIC(0)="AEMNZ",DIC("A")="   Select Case: "
  1.  D ^DIC
  1.  Q:Y<1
  1.  Q:$D(DTOUT)!($D(DUOUT))
  1.  S IEN=$P(Y,U)
  1.  D ^OOPSDIS                                      ; Display header info
  1.  S (FORM,CA)=$$GET1^DIQ(2260,IEN,52,"I")
  1.  S FORM=$S(FORM=1:"CA1",FORM=2:"CA2",1:"")
  1.  S CASIGN=$P($$EDSTA^OOPSUTL1(IEN,"S"),U,CA)     ; Super signed CA form
  1.  D FORMS ; Process correct form
  1.  I OUT=2 G EXIT
  1.  ; If controled fields have been edited, clear Sup fields, get re-signed
  1.  I $D(OOPS) S DONE=$$CHGES(DONE) I DONE D CLRFLDS,SUPFLDS D:'OUT SUPSIGN
  1.  I OUT G EXIT
  1.  ; Need to have WC enter Supervisor fields
  1.  I 'CASIGN D SUPFLDS D:'OUT SUPSIGN
  1. EXIT ; Validate and allow user to sign if all required fields complete
  1.  N DIR,Y
  1.  I OUT=1 D
  1.  . S DIR("A")="You '^'d out, Do you want to Sign"
  1.  . S DIR(0)="SBM^Y:Yes;N:No"
  1.  . D ^DIR
  1.  . I Y="Y" S OUT=0
  1.  I 'OUT D SIGNS(FORM)                 ; Sign/validate Document
  1.  L -^OOPS(2260,IEN)
  1.  Q
  1.  ;
  1. FORMS ; Process Form
  1.  N DA,DIE,DR,FLD,I,MAX,MAX1,RET,SAL,PAY
  1.  N AIEN,AGN,ADD,CITY,STATE,ZIP
  1.  N PNAME,PADD,PCITY,PSTATE,PZIP,PTITLE,STAT,SIEN
  1.  ; Patch 11 - Default Chargeback code, next 6 lines
  1.  N OWCP,STA
  1.  S OWCP=""
  1.  S STA=$$GET1^DIQ(2260,IEN,13,"I")
  1.  I STA S OWCP=$$FIND1^DIC(2262.03,",1,","Q",STA)
  1.  I OWCP S OWCP=OWCP_",1," S OWCP=$$GET1^DIQ(2262.03,OWCP,.7)
  1.  I 'OWCP S OWCP=""
  1.  S MAX1=528                          ; Max length on some WP fields
  1.  ; Get Default retirement from PAID - FLD = paid value
  1.  S FLD=28,SAL=""
  1.  S SAL=$$PAID^OOPSUTL1(IEN,FLD)
  1.  S FLD=26,RET=""
  1.  S RET=$$PAID^OOPSUTL1(IEN,FLD)
  1.  S RET=$S(RET="FULL CSRS":"CSRS",RET="FERS":"FERS",1:"OTHER")
  1.  S FLD=19,PAY=""
  1.  S PAY=$$PAID^OOPSUTL1(IEN,FLD)
  1.  S PAY=$S(PAY="PER ANNUM":"ANNUAL",PAY="PER HOUR":"HOURLY","PER DIEM":"DAILY","BIWEEKLY":"BI-WEEKLY",1:"")
  1.  ; If WCP has signed, clear signature - added 5/19/00
  1.  I $$GET1^DIQ(2260,IEN,67)'="" D CLRES^OOPSUTL1(IEN,"W",FORM)
  1.  ; If Super has not signed, prompt WC to continue or not
  1.  I 'CASIGN D WCSIGN Q:OUT
  1.  ; If Super has signed and person editing form is not Supervisor who
  1.  ; signed, then check for edits on certain fields.  ONLY FOR CA1
  1.  I FORM="CA1",CASIGN,($$GET1^DIQ(2260,IEN,169,"I")'=DUZ) D WCEDIT
  1.  L +^OOPS(2260,IEN):2
  1.  E  W !!?5,"Another user is editing this entry. Try later." S OUT=2 Q
  1.  I FORM="CA1" D CA1^OOPSWCE1 Q:OUT
  1.  I FORM="CA2" D CA2^OOPSWCE2 Q:OUT
  1.  S DIE="^OOPS(2260,",DA=IEN
  1.  D ^DIE
  1.  I ($D(Y)'=0)!($G(DIRUT)=1)  S OUT=1
  1.  Q
  1. WC(IEN) ; Selection Screen
  1.  ;    Input  - IEN   Internal entry number of case
  1.  ;   Output  - VIEW  If 0 case not accessible, if 1 case selectable
  1.  ;
  1.  N VIEW,FORM
  1.  S VIEW=1
  1.  S FORM=$$GET1^DIQ(2260,IEN,52,"I")
  1.  I '$P($$EDSTA^OOPSUTL1(IEN,"E"),U,FORM) S VIEW=0   ;Employee not signed
  1.  I $$GET1^DIQ(2260,IEN,66)'="" S VIEW=0             ;Case sent to DOL
  1.  I $$GET1^DIQ(2260,IEN,51,"I")'=0 S VIEW=0          ;Case is not open
  1.  I '$$ISEMP^OOPSUTL4(IEN) S VIEW=0                  ;not employee
  1.  Q VIEW
  1. WCEDIT ; check for edits by WC
  1.  ; Get data from fields 146, 147, 148, 149, 163, 164, 165.
  1.  N DA,DIC,DIQ,DR,%X,%Y
  1.  K OOPS
  1.  S DIC=2260,DR="146;147;148;149;163",DA=IEN,DIQ="OOPS",DIQ(0)="I"
  1.  D EN^DIQ1
  1.  S %X="^OOPS(2260,IEN,""CA1J"",",%Y="OOPS(2260,IEN,""CA1J""," D %XY^%RCR
  1.  S %X="^OOPS(2260,IEN,""CA1K"",",%Y="OOPS(2260,IEN,""CA1K""," D %XY^%RCR
  1.  Q
  1. WCSIGN ; Prompt user to continue as Supervisor if Super has not signed form
  1.  N DIR,Y
  1.  S DIR("A")="Are you signing for the Supervisor"
  1.  S DIR("A",1)="The Supervisor has not signed the "_FORM_".  To continue"
  1.  S DIR("A",2)="editing, you will need to sign as Supervisor."
  1.  S DIR(0)="SBM^Y:Yes;N:No"
  1.  D ^DIR
  1.  I Y'="Y" S OUT=1
  1.  Q
  1. SUPSIGN ; Sign/validate Document
  1.  N DIR,ES,SUPSIGN,VALID,Y
  1.  S VALID=0
  1.  D VALIDATE^OOPSUTL4(IEN,FORM,"S",.VALID)
  1.  I 'VALID S OUT=2 Q                     ; not valid, sup not signed
  1.  S DIR("A")="Sign as Supervisor"
  1.  S DIR(0)="SBM^Y:Yes;N:No"
  1.  D ^DIR
  1.  I Y'="Y" S OUT=2      ; sup 'signed, WC cant sign
  1.  I Y="Y" D
  1.  . S SUPSIGN=$$SIG^OOPSESIG(DUZ,IEN)
  1.  . S ES=$S(FORM="CA1":"CA1ES",FORM="CA2":"CA2ES",1:0)
  1.  . I $G(ES)'="" S $P(^OOPS(2260,IEN,ES),U,4,6)=SUPSIGN
  1.  Q
  1. SIGNS(FORM) ;
  1.  N PAYPLAN,DA,DIE,DR,VALID
  1.  S VALID=0,SIGN=""
  1.  S PAYPLAN=$$GET1^DIQ(2260,IEN,63)
  1.  I '$P($$EDSTA^OOPSUTL1(IEN,"S"),U,CA) D  Q        ; Super hasn't signed
  1.  . W !!,"Supervisor has not signed "_FORM
  1.  D VALIDATE^OOPSUTL4(IEN,FORM,"W",.VALID)
  1.  I 'VALID Q
  1.  ; V2.0 1/9/02 - fixes for Fee Basis, Non-Paid Employees
  1.  I $$GET1^DIQ(2260,IEN,2,"I")=6 D  Q
  1.  .W !,"This person is not in the PAID Employee File and does not appear "
  1.  .W !,"eligible to submit a claim to DOL.  Please check with your"
  1.  .W !,"Human Resources Department for assistance.  Sending a paper"
  1.  .W !,"hardcopy may be necessary, if allowable."
  1.  I (PAYPLAN="OT"),'$$VALEMP^OOPSUTL6 D  Q
  1.  .W !,"This person does not appear to be eligible for submitting a claim"
  1.  .W !,"to DOL, please review the RETIREMENT, GRADE, STEP, PAY"
  1.  .W !,"PLAN, PAY RATE and PAY RATE PER Fields.  You may need to"
  1.  .W !,"contact your Human Resources Department or IRM for assistance."
  1.  N DIR,Y
  1.  W !
  1.  S DIR("A")="OK to transmit to DOL"
  1.  S DIR(0)="SBM^Y:Yes;N:No"
  1.  D ^DIR
  1.  I Y="Y" S SIGN=$$SIG^OOPSESIG(DUZ,IEN)
  1.  ; if signed, file and send bulletin
  1.  I $P(SIGN,U) D
  1.  . S DR="",DIE="^OOPS(2260,",DA=IEN
  1.  . S DR(1,2260,1)="67////^S X=$P(SIGN,U)"
  1.  . S DR(1,2260,5)="68////^S X=$P(SIGN,U,2)"
  1.  . S DR(1,2260,10)="69////^S X=$P(SIGN,U,3)"
  1.  I $P(SIGN,U) D ^DIE,WCP^OOPSMBUL(IEN,"S")
  1.  Q
  1. CLRFLDS ; Clear Supervisor Signature fields
  1.  N DR,DA,DIE
  1.  ; Clear Supervisor Signature
  1.  ; Added next line for ASISTS V2.0 11/09/01
  1.  I '$$BROKER^XWBLIB D
  1.  . W !!,"Worker's Comp edit of special fields occurred, Supervisor"
  1.  . W !,"signature fields cleared, you will need to sign as Supervisor."
  1.  D CLRES^OOPSUTL1(IEN,"S",FORM)
  1.  ; If get in this subroutine, need to set flag that Super needs to
  1.  ; be notified of edits even if user ^'s out
  1.  S DR="",DIE="^OOPS(2260,",DA=IEN
  1.  S DR(1,2260,35)="199////Y"
  1.  D ^DIE
  1.  Q
  1. SUPFLDS ; Get Supervisor signature related data for CA1 only
  1.  I OUT Q
  1.  N DR,DA,DIE,SUP
  1.  S DR="",DIE="^OOPS(2260,",DA=IEN
  1.  ; Clear Super Title and Phone # and set DR array
  1.  I FORM="CA1" D
  1.  . S SUP=$$GET1^DIQ(200,DUZ,.01)
  1.  . S $P(^OOPS(2260,IEN,"CA1L"),U,4,5)="^"
  1.  . S DR(1,2260,1)="W !!,""       Worker's Compensation Signing for Supervisor"",!"
  1.  . S DR(1,2260,5)="W !,""      Signature of Supervisor and Filing Instructions"""
  1.  . S DR(1,2260,10)="W !,""      -----------------------------------------------"""
  1.  . S DR(1,2260,15)="S ITEM=38 D EXCEPT^OOPSUTL2;168    EXCEPTION"
  1.  . S DR(1,2260,16)="I X'="""",'$$VCHAR^OOPSUTL4(X) W !,""Invalid character entered, (~,`,@,#,$,%,^,*,_,|,\,},{,[,],>, or <),"",!,""please edit."",! S Y=168"
  1.  . S DR(1,2260,20)="W !,""     NAME OF SUPERVISOR.: ""_SUP"
  1.  . S DR(1,2260,25)="172     SUPERVISOR'S TITLE.;I X="""" S Y=172"
  1.  . S DR(1,2260,26)="I X'="""",'$$VCHAR^OOPSUTL4(X) W !,""Invalid character entered, (~,`,@,#,$,%,^,*,_,|,\,},{,[,],>, or <),"",!,""please edit."",! S Y=172"
  1.  . S DR(1,2260,30)="173     OFFICE PHONE.......;I X="""" S Y=173"
  1.  . ; Patch 8 - added error checking on phone per DOL requirement
  1.  . S DR(1,2260,35)="I $TR(X,""/-*#"","""")'?10N W !?3,""Phone number must include area code and 7 digits only.  Example 703-123-8789"" S Y=173"
  1.  D ^DIE
  1.  I ($D(Y)'=0)!($G(DIRUT)=1)  S OUT=2
  1.  Q
  1. CHGES(DONE) ; Verify changes have been made to controlled fields
  1.  ; Can quit as soon as any change is discovered
  1.  ;    Input -   none
  1.  ;   Output -   DONE   if 1, at least 1 field edited, else no edits (0)
  1.  ;
  1.  N I,LINE,LP
  1.  F I=146:1:149,163 D  Q:DONE
  1.  . I $$GET1^DIQ(2260,IEN,I,"I")'=OOPS(2260,IEN,I,"I") S DONE=1 Q
  1.  I 'DONE F I="CA1J","CA1K" I $D(OOPS(2260,IEN,I)) D  Q:DONE
  1.  . S LINE=$P(^OOPS(2260,IEN,I,0),U,4)
  1.  . I LINE'=$P(OOPS(2260,IEN,I,0),U,4) S DONE=1 Q
  1.  . F LP=1:1:LINE D  Q:DONE
  1.  .. I ^OOPS(2260,IEN,I,LP,0)'=OOPS(2260,IEN,I,LP,0) S DONE=1 Q
  1.  Q DONE