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

AGEDWC.m

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