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