AGEDWC ; IHS/ASDS/EFG - WORKMAN'S COMP PAGE ;
;;7.1;PATIENT REGISTRATION;**1,2,9**;AUG 25, 2005
;
;AG*7.1*9 - Reworked routine to add new Claim related fields
EN(WD0,WD1,NEWENTRY,AGSELECT) ;EP -
;IF ITS A NEW ENTRY THEN DISP THE SCREEN, DISP MESSAGE, AUTO-
;MATICALLY ENTER A NEW PATIENT RECORD THEN ASK FOR THE DATE OF WC
;INJURY
I NEWENTRY D Q:EXIT
.S EXIT=0
.;D DRAW,WMSG,NEWENTRY I +$G(Y)<0 D CLEANZER(WD0) W !,"New entry not made" H 3 D END S EXIT=1 Q
.;D DRAW,WMSG,NEWENTRY I +$G(Y)<0 D CLEANZER(WD0) W !,"New entry not made" H 3 D END S EXIT=1 Q
.D DRAW,WMSG,NEWENTRY I +$G(Y)<0 D:$G(WD0)'="" CLEANZER(WD0) W !,"New entry not made" H 3 D END S EXIT=1 Q ;IM20157 AG*7.1*1
.;AG*7.1*9 - Modified order/added new fields
.D ADTWC I +$G(Y)<0 D CLEANZER(WD0) W !,"New entry not made" H 3 D END S EXIT=1 Q
.D TYPEACC
.D DESCWI
.D EMPL
.D WPATATTY
.D GROUP
.D EFF
.D EXP
.D CLMFIL
.D CLMSTAT
.D CLMNO
.D DTLWRK
.D DSSTDT
.D DSENDT
.D DTAWRK
.D CONT
.D NOTES
.S COMPIEN=WD0_",11,"_WD1
.;S AGSELECT=$$UPDTSEL^AGUTILS("FINDWC",.AGINS,COMPIEN)
.S AGSELECT=$$UPDTSEL^AGUTILS(.AGINS,WD0_","_WD1,AGELP("INS")) ;AG*7.1*1 IM18549 ERROR IN ERROR MSG UPDATE
.S NEWENTRY=0
S COMPIEN=WD0_",11,"_WD1
VAR D DRAW
Q:$D(AGSEENLY)
W !,AGLINE("EQ")
K DIR
S DIR("A")="CHANGE which item? (1-"_AG("N")_") NONE// "
D READ^AGED1
;CHECK TO SEE IF THERE ARE ANY DATE ENTRIES LEFT. IF NOT CLEAR THE
;REMAINING TOP LEVEL RECORD SINCE NOTHING REALLY EXISTS FOR THIS
;PATIENT ANYMORE
I Y="",'$O(^AUPNWC(WD0,11,0)) D CLEAN(WD0),END Q
I $D(MYERRS("C","E")),(Y'?1N.N),(Y'=AGOPT("ESCAPE")) W !,"ERRORS ON THIS PAGE. PLEASE FIX BEFORE EXITING!!" H 3 G VAR
Q:Y=AGOPT("ESCAPE")
G:$D(AG("ED"))&'$D(AGXTERN) @("^AGED"_AG("ED"))
G END:$D(DLOUT)!(Y["N")!$D(DUOUT),VAR:$D(AG("ERR"))
Q:$D(DFOUT)!$D(DTOUT)
I $D(DQOUT)!(+Y<1)!(+Y>AG("N")) W !!,"You must enter a number from 1 to ",AG("N") H 2 G VAR
;AG*7.1*9 - Reordered, added fields
S AG("C")="DTWC,TYPEACC,DESCWI,EMPL,WPATATTY,ENTITY,GROUP,EFF,EXP,CLMFIL,CLMSTAT,CLMNO,DTLWRK,DSSTDT,DSENDT,DTAWRK,CONT,NOTES"
S AGY=Y
F AGI=1:1 S AG("SEL")=+$P(AGY,",",AGI) Q:AG("SEL")<1!(AG("SEL")>AG("N")) D @($P(AG("C"),",",AG("SEL")))
Q:$G(EXIT)=1
;I '$G(NEWENTRY) S AGSELECT=$$UPDTSEL^AGUTILS("FINDWC",.AGINS,COMPIEN)
I '$G(NEWENTRY) S AGSELECT=$$UPDTSEL^AGUTILS(.AGINS,WD0_","_WD1,$P(AGSELECT,U,2)) ;AG*7.1*1 IM18549 ERROR IN ERROR MSG UPDATE
D UPDATE1^AGED(DUZ(2),DFN,3,"")
K AGI,AGY
G VAR
CLEAN(WD0) ;CLEAN EMPTY RECORD. IF NO GUARANTOR HAS BEEN ENTERED THEN
;THE RECORD IS MEANINGLESS
;CHECK HERE TO SEE IF ENTRIES HAVE ACTUALLY BEEN ENTERED. IF NOT
;CLEAR THE REMAINING TOP LEVEL RECORD SINCE NOTHING REALLY EXISTS
;IN THIS RECORD
I '$O(^AUPNWC(WD0,11,0)) D
.W !,"There are is no injury date for this patient's workman's compensation entry.",!,"This record is being deleted." H 3
.D CLEANZER(WD0)
Q
CLEANZER(WD0) ;EP - CLEAN ZERO NODE WITH NO DATES
K DIK,DA
S DIK="^AUPNWC(",DA=WD0 D ^DIK
Q
END K DLOUT,DTOUT,DFOUT,DQOUT,DA,DIC,DR,AGSCRN,Y,ADA,WDA,ADT,WDT,ADFN,WDFN,REC,ROUTID
Q
DRAW ;EP
S AG("PG")="4WCA"
S ROUTID=$P($T(+1)," ")
D ^AGED
K ^UTILITY("DIQ1",$J)
W ?30,"WORKMAN'S COMPENSATION"
W !,AGLINE("-")
D GETAW
Q
GETAW ;DISPLAY
F AG=1:1 D Q:$G(AGSCRN)[("*END*")
. S AGSCRN=$P($T(@1+AG),";;",2,15)
. Q:AGSCRN[("*END*")
. I AG=4 W !,"EMPLOYER DATA"_$E(AGLINE("-"),1,66)
. I AG=5 W !,"ATTORNEY DATA"_$E(AGLINE("-"),1,66)
. I AG=6 W !,"INSURANCE COVERAGE"_$E(AGLINE("-"),1,61)
. I AG=10 W !,"CLAIM INFORMATION"_$E(AGLINE("-"),1,63)
. I AG=18 W !,$G(AGLINE("-"))
. S CAPTION=$P(AGSCRN,U)
. S DIC=$P(AGSCRN,U,3)
. S DR=$P(AGSCRN,U,4)
. S NEWLINE=$P(AGSCRN,U,5)
. S CAPDENT=$P(AGSCRN,U,2)
. W @NEWLINE,AG,".",@CAPDENT,$S($G(CAPTION)'="":CAPTION,1:$P($G(^DD(DIC,DR,0)),U)),": "
.;IF EDITING, DISP DATA ONLY
.;E DISP ONLY THE CAPS
.I 'NEWENTRY D
.. S D0=WD0
.. I DIC'["." S D0=D0_","
.. E S D0=WD1_","_D0_","
.. W $$GET1^DIQ(DIC,D0,DR)
.. I AG=7 W ?50,"GROUP NUMBER: ",$S($$GET1^DIQ(DIC,D0,DR,"I"):$P($G(^AUTNEGRP($$GET1^DIQ(DIC,D0,DR,"I"),0)),U,2),1:"")
S AG("N")=AG-1
W !,$G(AGLINE("-"))
K MYERRS,MYVARS
D FETCHERR^AGEDERR(AG("PG"),.MYERRS)
S MYVARS("DFN")=DFN,MYVARS("FINDCALL")="FINDWC",MYVARS("SELECTION")=$G(AGSELECT),MYVARS("SITE")=DUZ(2)
I '$G(NEWENTRY) D EDITCHEK^AGEDERR(.MYERRS,.MYVARS,1)
W !,$G(AGLINE("-"))
D VERIF^AGUTILS
I $D(AGSEENLY) S DIR("A")="Press return: ",DIR(0)="FO" D ^DIR Q
Q
WMSG ;DISP THIS MSG IF THERE IS NO ENTRY IN THE WORKMAN'S
;COMP GLOBAL
W !,"You must first enter the DATE OF WC INJURY"
Q
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; WORKMAN'S COMP INJURY FLDS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
NEWENTRY ;NEW ENTRY
W !!
K DIC,DIE,DR,DA
S DIC="^AUPNWC("
S DIC(0)="L"
S X="`"_DFN
K DD,DO
D ^DIC
Q:+Y'>0
S WD0=+Y
S NEWENTRY=0
Q
ADTWC ;ADD NEW DT RECORD
K DIC,DIE,DA,DR
S DA(1)=WD0
S DIC="^AUPNWC("_WD0_",11,"
S DIC(0)="AEL"
S DIC("P")=$P($G(^DD(9000042,1101,0)),U,2)
S DIC("DR")=".01;.11////^S X=$G(AGELP(""INS""))"
K DD,DO
D ^DIC
Q:+Y<1
S WD1=+Y
K DIC,DIE,DA,DR
Q
DTWC ;WORKMAN'S COMP INJURY DATE
K DIC,DIE,DR
S DA(1)=WD0
S DA=WD1
S DIE="^AUPNWC("_DA(1)_",11,"
S DR=".01"
D ^DIE
S:'$D(DA) EXIT=1
K DIC,DR,DIE
Q
DESCWI ;DESCRIPTION OF INJURY
K DIC,DR,DIE,DA,DD,DO
S DA=WD1
S DA(1)=WD0
S DIE="^AUPNWC("_DA(1)_",11,"
S DR=".02"
D ^DIE
K DIC,DR,DIE,DA
Q
CLMFIL ;WAS CLAIM FILED
K DIC,DR,DIE,DA,DD,DO
S DA=WD1
S DA(1)=WD0
S DIE="^AUPNWC("_DA(1)_",11,"
S DR=".03"
D ^DIE
K DIC,DR,DIE,DA
Q
CLMNO ;CLAIM #
K DIC,DR,DIE,DA,DD,DO
S DA=WD1
S DA(1)=WD0
S DIE="^AUPNWC("_DA(1)_",11,"
S DR=".04"
D ^DIE
K DIC,DR,DIE,DA
Q
WPATATTY ;NAME OF PATIENT'S ATTORNEY FOR WORKMAN'S COMP
K DIC,DR,DIE,DA,DD,DO
S DA=WD1
S DA(1)=WD0
S DIE="^AUPNWC("_DA(1)_",11,"
S DR=".05"
D ^DIE
K DIC,DR,DIE,DA
Q
EMPL ;PATIENT'S EMPLOYER
K DIC,DR,DIE,DA,DD,DO
S DA=WD1
S DA(1)=WD0
S DIE="^AUPNWC("_DA(1)_",11,"
S DR=".06"
D ^DIE
K DIC,DR,DIE,DA
Q
DTCLOSE ;DATE CASE CLOSED
K DIC,DR,DIE,DA,DD,DO
S DA=WD1
S DA(1)=WD0
S DIE="^AUPNWC("_DA(1)_",11,"
S DR=".07"
D ^DIE
K DIC,DR,DIE,DA
Q
TYPEACC ;TYPE OF ACCIDENT
W !
K DIC,DR,DIE,DA,DD,DO
S DA=WD1
S DA(1)=WD0
S DIE="^AUPNWC("_DA(1)_",11,"
S DR=".08"
D ^DIE
K DIC,DR,DIE,DA
Q
CLMSTAT ;CLAIM STATUS
W !
K DIC,DR,DIE,DA,DD,DO
S DA=WD1
S DA(1)=WD0
S DIE="^AUPNWC("_DA(1)_",11,"
S DR=".09"
D ^DIE
K DIC,DR,DIE,DA
Q
ENTITY ;WORKMAN'S COMP ENTITY
W !
K DIC,DR,DIE,DA,DD,DO
S DA=WD1
S DA(1)=WD0
S DIE="^AUPNWC("_DA(1)_",11,"
S DR=".11"
D ^DIE
K DIC,DR,DIE,DA
Q
GROUP ;GROUP NAME
W !
K DIC,DR,DIE,DA,DD,DO
S DA=WD1
S DA(1)=WD0
S DIE="^AUPNWC("_DA(1)_",11,"
S DR=".12"
D ^DIE
K DIC,DR,DIE,DA
Q
EFF ;EFF COV DATE
W !
K DIC,DR,DIE,DA,DD,DO
S DA=WD1
S DA(1)=WD0
S DIE="^AUPNWC("_DA(1)_",11,"
S DR=".13"
D ^DIE
K DIC,DR,DIE,DA
;COMPARE EFF AND EXP DATES
I '$$GOODDT(WD0,WD1) G EFF
Q
EXP ;EXPIRE DATE
W !
K DIC,DR,DIE,DA,DD,DO
S DA=WD1
S DA(1)=WD0
S DIE="^AUPNWC("_DA(1)_",11,"
S DR=".14"
D ^DIE
K DIC,DR,DIE,DA
;COMPARE EFF AND EXP DATES
I '$$GOODDT(WD0,WD1) G EXP
Q
;
DTLWRK ;DATE LAST WORKED - AG*7.1*9
W !
K DIC,DR,DIE,DA,DD,DO
S DA=WD1
S DA(1)=WD0
S DIE="^AUPNWC("_DA(1)_",11,"
S DR="201"
D ^DIE
K DIC,DR,DIE,DA
Q
;
DSSTDT ;DISABILITY START DATE - AG*7.1*9
W !
K DIC,DR,DIE,DA,DD,DO
S DA=WD1
S DA(1)=WD0
S DIE="^AUPNWC("_DA(1)_",11,"
S DR="202"
D ^DIE
K DIC,DR,DIE,DA
;COMPARE START AND END DATES
I '$$GDDDT(WD0,WD1) G DSSTDT
Q
;
DSENDT ;DISABILITY END DATE - AG*7.1*9
W !
K DIC,DR,DIE,DA,DD,DO
S DA=WD1
S DA(1)=WD0
S DIE="^AUPNWC("_DA(1)_",11,"
S DR="203"
D ^DIE
K DIC,DR,DIE,DA
;COMPARE START AND END DATES
I '$$GDDDT(WD0,WD1) G DSENDT
Q
;
DTAWRK ;DATE AUTHORIZED RETURN TO WORK - AG*7.1*9
W !
K DIC,DR,DIE,DA,DD,DO
S DA=WD1
S DA(1)=WD0
S DIE="^AUPNWC("_DA(1)_",11,"
S DR="204"
D ^DIE
K DIC,DR,DIE,DA
Q
;
CONT ;CONTACT INFO - AG*7.1*9
W !
K DIC,DR,DIE,DA,DD,DO
S DA=WD1
S DA(1)=WD0
S DIE="^AUPNWC("_DA(1)_",11,"
S DR="205"
D ^DIE
K DIC,DR,DIE,DA
Q
;
GDDDT(AD0,AD1) ;CHECK DISABILITY START/END DATES - AG*7.1*9
N BDT,EDT
S BDT=$$GET1^DIQ(9000042.11,AD1_","_AD0_",",202,"I") ;$P($G(^AUPNWC(WD0,1,WD1,0)),U,12)
S EDT=$$GET1^DIQ(9000042.11,AD1_","_AD0_",",203,"I") ;$P($G(^AUPNWC(WD0,1,WD1,0)),U,13)
I EDT,'BDT W !,"CANNOT HAVE AN ENDING DATE WITHOUT A BEGINNING DATE! TRY AGAIN" Q 0
I EDT<BDT&(+EDT'=0) W !,"DISABILITY ENDING DATE IS LESS THAN THE EFFECTIVE DATE! TRY AGAIN" Q 0
I BDT>EDT&(+EDT'=0) W !,"DISABILITY START DATE IS GREATER THAN THE ENDING DATE! TRY AGAIN" Q 0
Q 1
GOODDT(AD0,AD1) ;EP
N BDT,EDT
S BDT=$P($G(^AUPNWC(WD0,1,WD1,0)),U,12)
S EDT=$P($G(^AUPNWC(WD0,1,WD1,0)),U,13)
I EDT,'BDT W !,"CANNOT HAVE AN ENDING DATE WITHOUT A BEGINNING DATE! TRY AGAIN" Q 0
I EDT<BDT&(+EDT'=0) W !,"ENDING DATE IS LESS THAN THE EFFECTIVE DATE! TRY AGAIN" Q 0
I BDT>EDT&(+EDT'=0) W !,"EFFECTIVE DATE IS GREATER THAN THE ENDING DATE! TRY AGAIN" Q 0
Q 1
NOTES ;NOTES
W !
K DIC,DR,DIE,DA,DD,DO
S DA=WD1
S DA(1)=WD0
S DIE="^AUPNWC("_DA(1)_",11,"
S DR=".15"
D ^DIE
K DIC,DR,DIE,DA
Q
;AG*7.1*9 - Added fields, reordered others
; ****************************************************************
; ON LINES BELOW:
; PIECE 1= FLD LBL
; PIECE 2= POSITION ON LINE TO DISP FLD LBL
; PIECE 3= FILE #
; PIECE 4= FLD #
; PIECE 5= NEW LINE OR NOT
1 ;
;;WC INJURY DATE^?3^9000042.11^.01^!
;;TYPE OF ACCIDENT^?41^9000042.11^.08^?42
;;DESCRIPTION OF INJURY^?3^9000042.11^.02^!
;;EMPLOYER^?3^9000042.11^.06^!
;;NAME OF PATIENT'S ATTORNEY^?3^9000042.11^.05^!
;;WORKMAN'S COMP ENTITY^?3^9000042.11^.11^!
;;GROUP NAME^?3^9000042.11^.12^!
;;EFFECTIVE COVERAGE DATE^?3^9000042.11^.13^!
;;EXPIRATION DATE^?40^9000042.11^.14^?44
;;CLAIM FILED^?4^9000042.11^.03^!
;;CLAIM STATUS^?52^9000042.11^.09^?48
;;CLAIM NUMBER^?4^9000042.11^.04^!
;;DATE LAST WORKED^?47^9000042.11^201^?43
;;DISABILITY START DATE^?4^9000042.11^202^!
;;DISABILITY END DATE^?47^9000042.11^203^?43
;;DATE AUTHORIZED RETURN TO WORK^?4^9000042.11^204^!
;;CONTACT INFO^?4^9000042.11^205^!
;;NOTES^?4^9000042.11^.15^!
;;*END*
AGEDWC ; IHS/ASDS/EFG - WORKMAN'S COMP PAGE ;
+1 ;;7.1;PATIENT REGISTRATION;**1,2,9**;AUG 25, 2005
+2 ;
+3 ;AG*7.1*9 - Reworked routine to add new Claim related fields
EN(WD0,WD1,NEWENTRY,AGSELECT) ;EP -
+1 ;IF ITS A NEW ENTRY THEN DISP THE SCREEN, DISP MESSAGE, AUTO-
+2 ;MATICALLY ENTER A NEW PATIENT RECORD THEN ASK FOR THE DATE OF WC
+3 ;INJURY
+4 IF NEWENTRY
Begin DoDot:1
+5 SET EXIT=0
+6 ;D DRAW,WMSG,NEWENTRY I +$G(Y)<0 D CLEANZER(WD0) W !,"New entry not made" H 3 D END S EXIT=1 Q
+7 ;D DRAW,WMSG,NEWENTRY I +$G(Y)<0 D CLEANZER(WD0) W !,"New entry not made" H 3 D END S EXIT=1 Q
+8 ;IM20157 AG*7.1*1
DO DRAW
DO WMSG
DO NEWENTRY
IF +$GET(Y)<0
IF $GET(WD0)'=""
DO CLEANZER(WD0)
WRITE !,"New entry not made"
HANG 3
DO END
SET EXIT=1
QUIT
+9 ;AG*7.1*9 - Modified order/added new fields
+10 DO ADTWC
IF +$GET(Y)<0
DO CLEANZER(WD0)
WRITE !,"New entry not made"
HANG 3
DO END
SET EXIT=1
QUIT
+11 DO TYPEACC
+12 DO DESCWI
+13 DO EMPL
+14 DO WPATATTY
+15 DO GROUP
+16 DO EFF
+17 DO EXP
+18 DO CLMFIL
+19 DO CLMSTAT
+20 DO CLMNO
+21 DO DTLWRK
+22 DO DSSTDT
+23 DO DSENDT
+24 DO DTAWRK
+25 DO CONT
+26 DO NOTES
+27 SET COMPIEN=WD0_",11,"_WD1
+28 ;S AGSELECT=$$UPDTSEL^AGUTILS("FINDWC",.AGINS,COMPIEN)
+29 ;AG*7.1*1 IM18549 ERROR IN ERROR MSG UPDATE
SET AGSELECT=$$UPDTSEL^AGUTILS(.AGINS,WD0_","_WD1,AGELP("INS"))
+30 SET NEWENTRY=0
End DoDot:1
IF EXIT
QUIT
+31 SET COMPIEN=WD0_",11,"_WD1
VAR DO DRAW
+1 IF $DATA(AGSEENLY)
QUIT
+2 WRITE !,AGLINE("EQ")
+3 KILL DIR
+4 SET DIR("A")="CHANGE which item? (1-"_AG("N")_") NONE// "
+5 DO READ^AGED1
+6 ;CHECK TO SEE IF THERE ARE ANY DATE ENTRIES LEFT. IF NOT CLEAR THE
+7 ;REMAINING TOP LEVEL RECORD SINCE NOTHING REALLY EXISTS FOR THIS
+8 ;PATIENT ANYMORE
+9 IF Y=""
IF '$ORDER(^AUPNWC(WD0,11,0))
DO CLEAN(WD0)
DO END
QUIT
+10 IF $DATA(MYERRS("C","E"))
IF (Y'?1N.N)
IF (Y'=AGOPT("ESCAPE"))
WRITE !,"ERRORS ON THIS PAGE. PLEASE FIX BEFORE EXITING!!"
HANG 3
GOTO VAR
+11 IF Y=AGOPT("ESCAPE")
QUIT
+12 IF $DATA(AG("ED"))&'$DATA(AGXTERN)
GOTO @("^AGED"_AG("ED"))
+13 IF $DATA(DLOUT)!(Y["N")!$DATA(DUOUT)
GOTO END
IF $DATA(AG("ERR"))
GOTO VAR
+14 IF $DATA(DFOUT)!$DATA(DTOUT)
QUIT
+15 IF $DATA(DQOUT)!(+Y<1)!(+Y>AG("N"))
WRITE !!,"You must enter a number from 1 to ",AG("N")
HANG 2
GOTO VAR
+16 ;AG*7.1*9 - Reordered, added fields
+17 SET AG("C")="DTWC,TYPEACC,DESCWI,EMPL,WPATATTY,ENTITY,GROUP,EFF,EXP,CLMFIL,CLMSTAT,CLMNO,DTLWRK,DSSTDT,DSENDT,DTAWRK,CONT,NOTES"
+18 SET AGY=Y
+19 FOR AGI=1:1
SET AG("SEL")=+$PIECE(AGY,",",AGI)
IF AG("SEL")<1!(AG("SEL")>AG("N"))
QUIT
DO @($PIECE(AG("C"),",",AG("SEL")))
+20 IF $GET(EXIT)=1
QUIT
+21 ;I '$G(NEWENTRY) S AGSELECT=$$UPDTSEL^AGUTILS("FINDWC",.AGINS,COMPIEN)
+22 ;AG*7.1*1 IM18549 ERROR IN ERROR MSG UPDATE
IF '$GET(NEWENTRY)
SET AGSELECT=$$UPDTSEL^AGUTILS(.AGINS,WD0_","_WD1,$PIECE(AGSELECT,U,2))
+23 DO UPDATE1^AGED(DUZ(2),DFN,3,"")
+24 KILL AGI,AGY
+25 GOTO VAR
CLEAN(WD0) ;CLEAN EMPTY RECORD. IF NO GUARANTOR HAS BEEN ENTERED THEN
+1 ;THE RECORD IS MEANINGLESS
+2 ;CHECK HERE TO SEE IF ENTRIES HAVE ACTUALLY BEEN ENTERED. IF NOT
+3 ;CLEAR THE REMAINING TOP LEVEL RECORD SINCE NOTHING REALLY EXISTS
+4 ;IN THIS RECORD
+5 IF '$ORDER(^AUPNWC(WD0,11,0))
Begin DoDot:1
+6 WRITE !,"There are is no injury date for this patient's workman's compensation entry.",!,"This record is being deleted."
HANG 3
+7 DO CLEANZER(WD0)
End DoDot:1
+8 QUIT
CLEANZER(WD0) ;EP - CLEAN ZERO NODE WITH NO DATES
+1 KILL DIK,DA
+2 SET DIK="^AUPNWC("
SET DA=WD0
DO ^DIK
+3 QUIT
END KILL DLOUT,DTOUT,DFOUT,DQOUT,DA,DIC,DR,AGSCRN,Y,ADA,WDA,ADT,WDT,ADFN,WDFN,REC,ROUTID
+1 QUIT
DRAW ;EP
+1 SET AG("PG")="4WCA"
+2 SET ROUTID=$PIECE($TEXT(+1)," ")
+3 DO ^AGED
+4 KILL ^UTILITY("DIQ1",$JOB)
+5 WRITE ?30,"WORKMAN'S COMPENSATION"
+6 WRITE !,AGLINE("-")
+7 DO GETAW
+8 QUIT
GETAW ;DISPLAY
+1 FOR AG=1:1
Begin DoDot:1
+2 SET AGSCRN=$PIECE($TEXT(@1+AG),";;",2,15)
+3 IF AGSCRN[("*END*")
QUIT
+4 IF AG=4
WRITE !,"EMPLOYER DATA"_$EXTRACT(AGLINE("-"),1,66)
+5 IF AG=5
WRITE !,"ATTORNEY DATA"_$EXTRACT(AGLINE("-"),1,66)
+6 IF AG=6
WRITE !,"INSURANCE COVERAGE"_$EXTRACT(AGLINE("-"),1,61)
+7 IF AG=10
WRITE !,"CLAIM INFORMATION"_$EXTRACT(AGLINE("-"),1,63)
+8 IF AG=18
WRITE !,$GET(AGLINE("-"))
+9 SET CAPTION=$PIECE(AGSCRN,U)
+10 SET DIC=$PIECE(AGSCRN,U,3)
+11 SET DR=$PIECE(AGSCRN,U,4)
+12 SET NEWLINE=$PIECE(AGSCRN,U,5)
+13 SET CAPDENT=$PIECE(AGSCRN,U,2)
+14 WRITE @NEWLINE,AG,".",@CAPDENT,$SELECT($GET(CAPTION)'="":CAPTION,1:$PIECE($GET(^DD(DIC,DR,0)),U)),": "
+15 ;IF EDITING, DISP DATA ONLY
+16 ;E DISP ONLY THE CAPS
+17 IF 'NEWENTRY
Begin DoDot:2
+18 SET D0=WD0
+19 IF DIC'["."
SET D0=D0_","
+20 IF '$TEST
SET D0=WD1_","_D0_","
+21 WRITE $$GET1^DIQ(DIC,D0,DR)
+22 IF AG=7
WRITE ?50,"GROUP NUMBER: ",$SELECT($$GET1^DIQ(DIC,D0,DR,"I"):$PIECE($GET(^AUTNEGRP($$GET1^DIQ(DIC,D0,DR,"I"),0)),U,2),1:"")
End DoDot:2
End DoDot:1
IF $GET(AGSCRN)[("*END*")
QUIT
+23 SET AG("N")=AG-1
+24 WRITE !,$GET(AGLINE("-"))
+25 KILL MYERRS,MYVARS
+26 DO FETCHERR^AGEDERR(AG("PG"),.MYERRS)
+27 SET MYVARS("DFN")=DFN
SET MYVARS("FINDCALL")="FINDWC"
SET MYVARS("SELECTION")=$GET(AGSELECT)
SET MYVARS("SITE")=DUZ(2)
+28 IF '$GET(NEWENTRY)
DO EDITCHEK^AGEDERR(.MYERRS,.MYVARS,1)
+29 WRITE !,$GET(AGLINE("-"))
+30 DO VERIF^AGUTILS
+31 IF $DATA(AGSEENLY)
SET DIR("A")="Press return: "
SET DIR(0)="FO"
DO ^DIR
QUIT
+32 QUIT
WMSG ;DISP THIS MSG IF THERE IS NO ENTRY IN THE WORKMAN'S
+1 ;COMP GLOBAL
+2 WRITE !,"You must first enter the DATE OF WC INJURY"
+3 QUIT
+4 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+5 ; WORKMAN'S COMP INJURY FLDS
+6 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
NEWENTRY ;NEW ENTRY
+1 WRITE !!
+2 KILL DIC,DIE,DR,DA
+3 SET DIC="^AUPNWC("
+4 SET DIC(0)="L"
+5 SET X="`"_DFN
+6 KILL DD,DO
+7 DO ^DIC
+8 IF +Y'>0
QUIT
+9 SET WD0=+Y
+10 SET NEWENTRY=0
+11 QUIT
ADTWC ;ADD NEW DT RECORD
+1 KILL DIC,DIE,DA,DR
+2 SET DA(1)=WD0
+3 SET DIC="^AUPNWC("_WD0_",11,"
+4 SET DIC(0)="AEL"
+5 SET DIC("P")=$PIECE($GET(^DD(9000042,1101,0)),U,2)
+6 SET DIC("DR")=".01;.11////^S X=$G(AGELP(""INS""))"
+7 KILL DD,DO
+8 DO ^DIC
+9 IF +Y<1
QUIT
+10 SET WD1=+Y
+11 KILL DIC,DIE,DA,DR
+12 QUIT
DTWC ;WORKMAN'S COMP INJURY DATE
+1 KILL DIC,DIE,DR
+2 SET DA(1)=WD0
+3 SET DA=WD1
+4 SET DIE="^AUPNWC("_DA(1)_",11,"
+5 SET DR=".01"
+6 DO ^DIE
+7 IF '$DATA(DA)
SET EXIT=1
+8 KILL DIC,DR,DIE
+9 QUIT
DESCWI ;DESCRIPTION OF INJURY
+1 KILL DIC,DR,DIE,DA,DD,DO
+2 SET DA=WD1
+3 SET DA(1)=WD0
+4 SET DIE="^AUPNWC("_DA(1)_",11,"
+5 SET DR=".02"
+6 DO ^DIE
+7 KILL DIC,DR,DIE,DA
+8 QUIT
CLMFIL ;WAS CLAIM FILED
+1 KILL DIC,DR,DIE,DA,DD,DO
+2 SET DA=WD1
+3 SET DA(1)=WD0
+4 SET DIE="^AUPNWC("_DA(1)_",11,"
+5 SET DR=".03"
+6 DO ^DIE
+7 KILL DIC,DR,DIE,DA
+8 QUIT
CLMNO ;CLAIM #
+1 KILL DIC,DR,DIE,DA,DD,DO
+2 SET DA=WD1
+3 SET DA(1)=WD0
+4 SET DIE="^AUPNWC("_DA(1)_",11,"
+5 SET DR=".04"
+6 DO ^DIE
+7 KILL DIC,DR,DIE,DA
+8 QUIT
WPATATTY ;NAME OF PATIENT'S ATTORNEY FOR WORKMAN'S COMP
+1 KILL DIC,DR,DIE,DA,DD,DO
+2 SET DA=WD1
+3 SET DA(1)=WD0
+4 SET DIE="^AUPNWC("_DA(1)_",11,"
+5 SET DR=".05"
+6 DO ^DIE
+7 KILL DIC,DR,DIE,DA
+8 QUIT
EMPL ;PATIENT'S EMPLOYER
+1 KILL DIC,DR,DIE,DA,DD,DO
+2 SET DA=WD1
+3 SET DA(1)=WD0
+4 SET DIE="^AUPNWC("_DA(1)_",11,"
+5 SET DR=".06"
+6 DO ^DIE
+7 KILL DIC,DR,DIE,DA
+8 QUIT
DTCLOSE ;DATE CASE CLOSED
+1 KILL DIC,DR,DIE,DA,DD,DO
+2 SET DA=WD1
+3 SET DA(1)=WD0
+4 SET DIE="^AUPNWC("_DA(1)_",11,"
+5 SET DR=".07"
+6 DO ^DIE
+7 KILL DIC,DR,DIE,DA
+8 QUIT
TYPEACC ;TYPE OF ACCIDENT
+1 WRITE !
+2 KILL DIC,DR,DIE,DA,DD,DO
+3 SET DA=WD1
+4 SET DA(1)=WD0
+5 SET DIE="^AUPNWC("_DA(1)_",11,"
+6 SET DR=".08"
+7 DO ^DIE
+8 KILL DIC,DR,DIE,DA
+9 QUIT
CLMSTAT ;CLAIM STATUS
+1 WRITE !
+2 KILL DIC,DR,DIE,DA,DD,DO
+3 SET DA=WD1
+4 SET DA(1)=WD0
+5 SET DIE="^AUPNWC("_DA(1)_",11,"
+6 SET DR=".09"
+7 DO ^DIE
+8 KILL DIC,DR,DIE,DA
+9 QUIT
ENTITY ;WORKMAN'S COMP ENTITY
+1 WRITE !
+2 KILL DIC,DR,DIE,DA,DD,DO
+3 SET DA=WD1
+4 SET DA(1)=WD0
+5 SET DIE="^AUPNWC("_DA(1)_",11,"
+6 SET DR=".11"
+7 DO ^DIE
+8 KILL DIC,DR,DIE,DA
+9 QUIT
GROUP ;GROUP NAME
+1 WRITE !
+2 KILL DIC,DR,DIE,DA,DD,DO
+3 SET DA=WD1
+4 SET DA(1)=WD0
+5 SET DIE="^AUPNWC("_DA(1)_",11,"
+6 SET DR=".12"
+7 DO ^DIE
+8 KILL DIC,DR,DIE,DA
+9 QUIT
EFF ;EFF COV DATE
+1 WRITE !
+2 KILL DIC,DR,DIE,DA,DD,DO
+3 SET DA=WD1
+4 SET DA(1)=WD0
+5 SET DIE="^AUPNWC("_DA(1)_",11,"
+6 SET DR=".13"
+7 DO ^DIE
+8 KILL DIC,DR,DIE,DA
+9 ;COMPARE EFF AND EXP DATES
+10 IF '$$GOODDT(WD0,WD1)
GOTO EFF
+11 QUIT
EXP ;EXPIRE DATE
+1 WRITE !
+2 KILL DIC,DR,DIE,DA,DD,DO
+3 SET DA=WD1
+4 SET DA(1)=WD0
+5 SET DIE="^AUPNWC("_DA(1)_",11,"
+6 SET DR=".14"
+7 DO ^DIE
+8 KILL DIC,DR,DIE,DA
+9 ;COMPARE EFF AND EXP DATES
+10 IF '$$GOODDT(WD0,WD1)
GOTO EXP
+11 QUIT
+12 ;
DTLWRK ;DATE LAST WORKED - AG*7.1*9
+1 WRITE !
+2 KILL DIC,DR,DIE,DA,DD,DO
+3 SET DA=WD1
+4 SET DA(1)=WD0
+5 SET DIE="^AUPNWC("_DA(1)_",11,"
+6 SET DR="201"
+7 DO ^DIE
+8 KILL DIC,DR,DIE,DA
+9 QUIT
+10 ;
DSSTDT ;DISABILITY START DATE - AG*7.1*9
+1 WRITE !
+2 KILL DIC,DR,DIE,DA,DD,DO
+3 SET DA=WD1
+4 SET DA(1)=WD0
+5 SET DIE="^AUPNWC("_DA(1)_",11,"
+6 SET DR="202"
+7 DO ^DIE
+8 KILL DIC,DR,DIE,DA
+9 ;COMPARE START AND END DATES
+10 IF '$$GDDDT(WD0,WD1)
GOTO DSSTDT
+11 QUIT
+12 ;
DSENDT ;DISABILITY END DATE - AG*7.1*9
+1 WRITE !
+2 KILL DIC,DR,DIE,DA,DD,DO
+3 SET DA=WD1
+4 SET DA(1)=WD0
+5 SET DIE="^AUPNWC("_DA(1)_",11,"
+6 SET DR="203"
+7 DO ^DIE
+8 KILL DIC,DR,DIE,DA
+9 ;COMPARE START AND END DATES
+10 IF '$$GDDDT(WD0,WD1)
GOTO DSENDT
+11 QUIT
+12 ;
DTAWRK ;DATE AUTHORIZED RETURN TO WORK - AG*7.1*9
+1 WRITE !
+2 KILL DIC,DR,DIE,DA,DD,DO
+3 SET DA=WD1
+4 SET DA(1)=WD0
+5 SET DIE="^AUPNWC("_DA(1)_",11,"
+6 SET DR="204"
+7 DO ^DIE
+8 KILL DIC,DR,DIE,DA
+9 QUIT
+10 ;
CONT ;CONTACT INFO - AG*7.1*9
+1 WRITE !
+2 KILL DIC,DR,DIE,DA,DD,DO
+3 SET DA=WD1
+4 SET DA(1)=WD0
+5 SET DIE="^AUPNWC("_DA(1)_",11,"
+6 SET DR="205"
+7 DO ^DIE
+8 KILL DIC,DR,DIE,DA
+9 QUIT
+10 ;
GDDDT(AD0,AD1) ;CHECK DISABILITY START/END DATES - AG*7.1*9
+1 NEW BDT,EDT
+2 ;$P($G(^AUPNWC(WD0,1,WD1,0)),U,12)
SET BDT=$$GET1^DIQ(9000042.11,AD1_","_AD0_",",202,"I")
+3 ;$P($G(^AUPNWC(WD0,1,WD1,0)),U,13)
SET EDT=$$GET1^DIQ(9000042.11,AD1_","_AD0_",",203,"I")
+4 IF EDT
IF 'BDT
WRITE !,"CANNOT HAVE AN ENDING DATE WITHOUT A BEGINNING DATE! TRY AGAIN"
QUIT 0
+5 IF EDT<BDT&(+EDT'=0)
WRITE !,"DISABILITY ENDING DATE IS LESS THAN THE EFFECTIVE DATE! TRY AGAIN"
QUIT 0
+6 IF BDT>EDT&(+EDT'=0)
WRITE !,"DISABILITY START DATE IS GREATER THAN THE ENDING DATE! TRY AGAIN"
QUIT 0
+7 QUIT 1
GOODDT(AD0,AD1) ;EP
+1 NEW BDT,EDT
+2 SET BDT=$PIECE($GET(^AUPNWC(WD0,1,WD1,0)),U,12)
+3 SET EDT=$PIECE($GET(^AUPNWC(WD0,1,WD1,0)),U,13)
+4 IF EDT
IF 'BDT
WRITE !,"CANNOT HAVE AN ENDING DATE WITHOUT A BEGINNING DATE! TRY AGAIN"
QUIT 0
+5 IF EDT<BDT&(+EDT'=0)
WRITE !,"ENDING DATE IS LESS THAN THE EFFECTIVE DATE! TRY AGAIN"
QUIT 0
+6 IF BDT>EDT&(+EDT'=0)
WRITE !,"EFFECTIVE DATE IS GREATER THAN THE ENDING DATE! TRY AGAIN"
QUIT 0
+7 QUIT 1
NOTES ;NOTES
+1 WRITE !
+2 KILL DIC,DR,DIE,DA,DD,DO
+3 SET DA=WD1
+4 SET DA(1)=WD0
+5 SET DIE="^AUPNWC("_DA(1)_",11,"
+6 SET DR=".15"
+7 DO ^DIE
+8 KILL DIC,DR,DIE,DA
+9 QUIT
+10 ;AG*7.1*9 - Added fields, reordered others
+11 ; ****************************************************************
+12 ; ON LINES BELOW:
+13 ; PIECE 1= FLD LBL
+14 ; PIECE 2= POSITION ON LINE TO DISP FLD LBL
+15 ; PIECE 3= FILE #
+16 ; PIECE 4= FLD #
+17 ; PIECE 5= NEW LINE OR NOT
1 ;
+1 ;;WC INJURY DATE^?3^9000042.11^.01^!
+2 ;;TYPE OF ACCIDENT^?41^9000042.11^.08^?42
+3 ;;DESCRIPTION OF INJURY^?3^9000042.11^.02^!
+4 ;;EMPLOYER^?3^9000042.11^.06^!
+5 ;;NAME OF PATIENT'S ATTORNEY^?3^9000042.11^.05^!
+6 ;;WORKMAN'S COMP ENTITY^?3^9000042.11^.11^!
+7 ;;GROUP NAME^?3^9000042.11^.12^!
+8 ;;EFFECTIVE COVERAGE DATE^?3^9000042.11^.13^!
+9 ;;EXPIRATION DATE^?40^9000042.11^.14^?44
+10 ;;CLAIM FILED^?4^9000042.11^.03^!
+11 ;;CLAIM STATUS^?52^9000042.11^.09^?48
+12 ;;CLAIM NUMBER^?4^9000042.11^.04^!
+13 ;;DATE LAST WORKED^?47^9000042.11^201^?43
+14 ;;DISABILITY START DATE^?4^9000042.11^202^!
+15 ;;DISABILITY END DATE^?47^9000042.11^203^?43
+16 ;;DATE AUTHORIZED RETURN TO WORK^?4^9000042.11^204^!
+17 ;;CONTACT INFO^?4^9000042.11^205^!
+18 ;;NOTES^?4^9000042.11^.15^!
+19 ;;*END*
