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

AGEDTPL.m

Go to the documentation of this file. 
  1. AGEDTPL ; IHS/ASDS/TPF - THIRD PARTY LIABILITY ;    
  1.  ;;7.1;PATIENT REGISTRATION;**1,2,9**;AUG 25, 2005
  1.  ;A NEW THIRD PART LIABILITY DISPLAY PAGE. REPLACES AGED4B WHICH IS
  1.  ;OBSOLETE
  1.  ;AG*7.1*9 - CHANGES TO CODE TO ADD CLAIM INFORMATION SECTION
  1.  ;
  1. EN(AD0,AD1,NEWENTRY,AGSELECT,AGELPINS) ;EP
  1.  ;IF ITS A NEW ENTRY THEN DISP THE SCREEN, MSG, AND AUTOMATICALLY
  1.  ;ENTER A NEW PATIENT RECORD THEN ASK FOR THE DATE OF INJURY
  1.  K TPLDEL
  1.  I NEWENTRY D  Q:EXIT
  1.  .S EXIT=0
  1.  .D DRAW,AMSG,NEWENTRY I +$G(Y)<0 S EXIT=1 W !,"Entry not made." D CLEAN(AD0) H 2 D END Q
  1.  .D DESCAI
  1.  .D CAUSE
  1.  .D RESPNAM
  1.  .D RESPSSN
  1.  .D RESPINS
  1.  .D POLEFF
  1.  .D POLEND
  1.  .D GRPNAME
  1.  .D POLNO
  1.  .D APATATTY
  1.  .D CLM
  1.  .D DTLWRK
  1.  .D DTSDIS
  1.  .D DTEDIS
  1.  .D DTRWRK
  1.  .D CNTINF
  1.  .D NOTES
  1.  .S COMPIEN=AD0_",1,"_AD1
  1.  .;S AGSELECT=$$UPDTSEL^AGUTILS("FINDTPL",.AGINS,COMPIEN)
  1.  .S AGSELECT=$$UPDTSEL^AGUTILS(.AGINS,COMPIEN,AGELP("INS"))  ;AG*7.1*1 IM18549 ERROR IN ERROR UPDATE
  1.  .S NEWENTRY=0
  1.  S COMPIEN=AD0_",1,"_AD1
  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
  1.  ;THE REMAINING TOP LEVEL RECORD SINCE NOTHING REALLY EXISTS FOR
  1.  ;THIS PATIENT ANYMORE
  1.  I Y="",'$O(^AUPNTPL(AD0,1,0)) D CLEAN(AD0) Q
  1.  I Y[(",") G CONT
  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 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. CONT ;DATE OF INJURY; DESC OF INJURY; CAUSE OF INJURY; RESPONSIBLE
  1.  ;PARTY NAME; RESPONSIBLE PARTY SSN; RESPONSIBLE INSURANCE COMPANY;
  1.  ;POLICY EFF DATE; POLICY END DATE; GROUP NAME; GROUP #;
  1.  ;POLICY #; PATIENT'S ATTORNEY; NOTES
  1.  S AG("C")="DTACC,DESCAI,CAUSE,RESPNAM,RESPSSN,RESPINS,POLEFF,POLEND,GRPNAME,POLNO,APATATTY,CLM,DTLWRK,DTSDIS,DTEDIS,DTRWRK,CNTINF,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.  ;AFTER EDITING THE SELECTION MUST BE UPDATED SO ANY ERRORS
  1.  ;CORRECTED WILL BE REFLECTED ON THE REDRAWN SCREEN
  1.  I $G(TPLDEL) Q
  1.  ;S AGSELECT=$$UPDTSEL^AGUTILS("FINDTPL",.AGINS,COMPIEN)
  1.  S AGSELECT=$$UPDTSEL^AGUTILS(.AGINS,COMPIEN,$P(AGSELECT,U,2))  ;AG*7.1*1 IM18549 ERROR IN ERROR UPDATE
  1.  D UPDATE1^AGED(DUZ(2),DFN,3,"")
  1.  K AGI,AGY
  1.  G VAR
  1. CLEAN(AD0) ;EP - CHECK HERE TO SEE IF ENTRIES HAVE ACTUALLY BEEN
  1.  ;ENTERED. IF NOT, CLEAR THE REMAINING TOP LEVEL RECORD SINCE
  1.  ;NOTHING REALLY EXISTS IN THIS RECORD
  1.  I '$O(^AUPNTPL(AD0,1,0)) D CLEANZER(AD0)
  1.  Q
  1. CLEANZER(AD0) ;EP - CLEAN ZERO NODE WITH NO DATES
  1.  K DIK,DA
  1.  S DIK="^AUPNTPL(",DA=AD0 D ^DIK
  1.  Q
  1. END K AG,DLOUT,DTOUT,DFOUT,DQOUT,DA,DIC,DR,AGSCRN,Y,ADA,WDA,ADT,WDT
  1.  K ADFN,WDFN,REC,ROUTID,TPLDEL,COMPIEN
  1.  Q
  1. DRAW ;EP
  1.  S AG("PG")="4TPLA"
  1.  S ROUTID=$P($T(+1)," ")
  1.  S SEQHD="THIRD PARTY LIABILITY"
  1.  D ^AGED
  1.  K ^UTILITY("DIQ1",$J)
  1.  W ?30,"THIRD PARTY LIABILITY"
  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,14)
  1.  . Q:AGSCRN[("*END*")
  1.  . I AG=4 W !,"-RESPONSIBLE PARTY--------------------------------------------------------------"
  1.  . I AG=7 W !,"-COVERAGE DATA------------------------------------------------------------------"
  1.  . I AG=12 W !,"-CLAIM INFORMATION--------------------------------------------------------------"
  1.  . I AG=18 W !,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,$S(AG=2:3,AG=3:2,1:AG),".",@CAPDENT,$S($G(CAPTION)'="":CAPTION,1:$P($G(^DD(DIC,DR,0)),U)),": " ;AG*7.1*9 - Removed extra space after :
  1.  .;IF EDITING DISP DATA ONLY
  1.  .;E DISP ONLY THE CAPS
  1.  .I 'NEWENTRY D
  1.  .. S D0=AD0
  1.  .. I DIC'["." S D0=D0_","
  1.  .. E  S D0=AD1_","_D0_","
  1.  .. W $$GET1^DIQ(DIC,D0,DR)
  1.  .. ;I AG=2 D WRAP^AGUTILS($$GET1^DIQ(DIC,D0,DR),52,"WC10")
  1.  .. I AG=9 W ?42,"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")="FINDTPL",MYVARS("SITE")=DUZ(2),MYVARS("SELECTION")=$G(AGSELECT)
  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. AMSG ;DISP THIS MSG IF THERE NO ENTRY IN THE THIRD PARTY LIABILITY
  1.  ;FILE GLOBAL
  1.  W !,"You must first enter the DATE OF INJURY"
  1.  Q
  1.  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1.  ; THIRD PARTY LIABILITY FLDS
  1.  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1. NEWENTRY ;TOTALLY NEW ENTRY
  1.  W !!
  1.  K DIC,DIE,DR,DA
  1.  S DIC="^AUPNTPL("
  1.  S DIC(0)="L"
  1.  S X="`"_DFN
  1.  K DD,DO
  1.  D ^DIC
  1.  Q:Y<0
  1.  S AD0=+Y
  1.  S NEWENTRY=0
  1. ADDDT ;
  1.  K DIC,DIE,DR,DA
  1.  S DA(1)=AD0
  1.  S DIC="^AUPNTPL("_DA(1)_",1,"
  1.  S DIC(0)="LAE"
  1.  K DD,DO
  1.  D ^DIC
  1.  Q:Y<0
  1.  S AD1=+Y
  1.  I $G(AGELPINS)'="" D
  1.  .S DIE="^AUPNTPL("_DA(1)_",1,"
  1.  .S DA(1)=AD0
  1.  .S DR=".02////^S X=AGELPINS"
  1.  .S DA=AD1
  1.  .D ^DIE
  1.  Q
  1. DTACC ;DATE OF INJURY
  1.  I '$D(^AUPNTPL(AD0)) D NEWENTRY Q
  1.  K DIC,DR,DIE,DA,DD,D0
  1.  S TPLDEL=0
  1.  S DA(1)=AD0
  1.  S DA=AD1
  1.  S DIE="^AUPNTPL("_DA(1)_",1,"
  1.  S DR=".01"
  1.  D ^DIE
  1.  I '$D(DA) S TPLDEL=1
  1.  S:$G(D1)'="" AD1=D1  ;GET NEW SUBENTRY IEN
  1.  K DIC,DR,DIE
  1.  Q
  1. DESCAI ;DESC OF INJURY
  1.  W !
  1.  K DIC,DR,DIE,DA,DD,DO
  1.  S DA=AD1
  1.  S DA(1)=AD0
  1.  S DIE="^AUPNTPL("_DA(1)_",1,"
  1.  S DR="105"
  1.  D ^DIE
  1.  K DIC,DR,DIE,DA
  1.  Q
  1. CAUSE ;CAUSE OF INJURY
  1.  W !
  1.  K DIC,DR,DIE,DA,DD,DO
  1.  S DA=AD1
  1.  S DA(1)=AD0
  1.  S DIE="^AUPNTPL("_DA(1)_",1,"
  1.  S DR="104"
  1.  D ^DIE
  1.  K DIC,DR,DIE,DA
  1.  Q
  1. RESPNAM ;RESPONSIBLE PARTY NAME
  1.  W !
  1.  K DIC,DR,DIE,DA,DD,DO
  1.  S DA=AD1
  1.  S DA(1)=AD0
  1.  S DIE="^AUPNTPL("_DA(1)_",1,"
  1.  S DR="101"
  1.  D ^DIE
  1.  K DIC,DR,DIE,DA
  1.  Q
  1. RESPSSN ;RESPONSIBLE PARTY SSN
  1.  W !
  1.  K DIC,DR,DIE,DA,DD,DO
  1.  S DA=AD1
  1.  S DA(1)=AD0
  1.  S DIE="^AUPNTPL("_DA(1)_",1,"
  1.  S DR="102"
  1.  D ^DIE
  1.  K DIC,DR,DIE,DA
  1.  Q
  1. RESPINS ;RESPONSIBLE PARTY INSURANCE COMPANY
  1.  W !
  1.  K DIC,DR,DIE,DA,DD,DO
  1.  S DA=AD1
  1.  S DA(1)=AD0
  1.  S DIE="^AUPNTPL("_DA(1)_",1,"
  1.  S DR=".02"
  1.  D ^DIE
  1.  K DIC,DR,DIE,DA
  1.  Q
  1. POLEFF ;EFF DATE
  1.  W !
  1.  K DIC,DR,DIE,DA,DD,DO
  1.  S DA=AD1
  1.  S DA(1)=AD0
  1.  S DIE="^AUPNTPL("_DA(1)_",1,"
  1.  S DR=".04"
  1.  D ^DIE
  1.  K DIC,DR,DIE,DA
  1.  ;COMPARE EFF AND END DATES
  1.  I '$$GOODDT(AD0,AD1) G POLEFF
  1.  Q
  1. POLEND ;END DATE
  1.  W !
  1.  K DIC,DR,DIE,DA,DD,DO
  1.  S DA=AD1
  1.  S DA(1)=AD0
  1.  S DIE="^AUPNTPL("_DA(1)_",1,"
  1.  S DR=".05"
  1.  D ^DIE
  1.  K DIC,DR,DIE,DA
  1.  ;COMPARE EFF AND END DATES
  1.  I '$$GOODDT(AD0,AD1) G POLEND
  1.  Q
  1. GOODDT(AD0,AD1) ;EP - CHECK IF EFF AND END DATES MAKE SENSE
  1.  N BDT,EDT
  1.  S BDT=$P($G(^AUPNTPL(AD0,1,AD1,0)),U,4)
  1.  S EDT=$P($G(^AUPNTPL(AD0,1,AD1,0)),U,5)
  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.  ;
  1. GDDDT(AD0,AD1) ;CHECK DISABILITY START/END DATES - AG*7.1*9
  1.  N BDT,EDT
  1.  S BDT=$$GET1^DIQ(9000041.0101,AD1_","_AD0_",",203,"I")  ;$P($G(^AUPNWC(WD0,1,WD1,0)),U,12)
  1.  S EDT=$$GET1^DIQ(9000041.0101,AD1_","_AD0_",",204,"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. CLM ;CLAIM # - AG*7.1*9
  1.  W !
  1.  K DIC,DR,DIE,DA,DD,DO
  1.  S DA=AD1
  1.  S DA(1)=AD0
  1.  S DIE="^AUPNTPL("_DA(1)_",1,"
  1.  S DR="201"
  1.  D ^DIE
  1.  K DIC,DR,DIE,DA
  1.  Q
  1. DTLWRK ;DATE LAST WORKED - AG*7.1*9
  1.  W !
  1.  K DIC,DR,DIE,DA,DD,DO
  1.  S DA=AD1
  1.  S DA(1)=AD0
  1.  S DIE="^AUPNTPL("_DA(1)_",1,"
  1.  S DR="202"
  1.  D ^DIE
  1.  K DIC,DR,DIE,DA
  1.  Q
  1. DTSDIS ;DISABILITY START DATE - AG*7.1*9
  1.  W !
  1.  K DIC,DR,DIE,DA,DD,DO
  1.  S DA=AD1
  1.  S DA(1)=AD0
  1.  S DIE="^AUPNTPL("_DA(1)_",1,"
  1.  S DR="203"
  1.  D ^DIE
  1.  K DIC,DR,DIE,DA
  1.  I '$$GDDDT(AD0,AD1) G DTSDIS
  1.  Q
  1. DTEDIS ;DISABILITY END DATE - AG*7.1*9
  1.  W !
  1.  K DIC,DR,DIE,DA,DD,DO
  1.  S DA=AD1
  1.  S DA(1)=AD0
  1.  S DIE="^AUPNTPL("_DA(1)_",1,"
  1.  S DR="204"
  1.  D ^DIE
  1.  K DIC,DR,DIE,DA
  1.  I '$$GDDDT(AD0,AD1) G DTEDIS
  1.  Q
  1. DTRWRK ;DATE AUTHORIZED TO WORK - AG*7.1*9
  1.  W !
  1.  K DIC,DR,DIE,DA,DD,DO
  1.  S DA=AD1
  1.  S DA(1)=AD0
  1.  S DIE="^AUPNTPL("_DA(1)_",1,"
  1.  S DR="205"
  1.  D ^DIE
  1.  K DIC,DR,DIE,DA
  1.  Q
  1. CNTINF ;CONTACT INFO - AG*7.1*9
  1.  W !
  1.  K DIC,DR,DIE,DA,DD,DO
  1.  S DA=AD1
  1.  S DA(1)=AD0
  1.  S DIE="^AUPNTPL("_DA(1)_",1,"
  1.  S DR="206"
  1.  D ^DIE
  1.  K DIC,DR,DIE,DA
  1.  Q
  1. GRPNAME ;GROUP NAME AND #
  1.  W !
  1.  K DIC,DR,DIE,DA,DD,DO
  1.  S DA=AD1
  1.  S DA(1)=AD0
  1.  S DIE="^AUPNTPL("_DA(1)_",1,"
  1.  S DR=".06"
  1.  D ^DIE
  1.  K DIC,DR,DIE,DA
  1. GRPNUM ;GROUP #
  1.  Q
  1. POLNO ;INSURANCE POLICY #
  1.  W !
  1.  K DIC,DR,DIE,DA,DD,DO
  1.  S DA=AD1
  1.  S DA(1)=AD0
  1.  S DIE="^AUPNTPL("_DA(1)_",1,"
  1.  I $$ISREQ^AGFLDREQ(9000041,.03) S DIE("NO^")="",DR=".03R"
  1.  E  S DR=".03"
  1.  D ^DIE
  1.  K DIC,DR,DIE,DA
  1.  Q
  1. APATATTY ;NAME OF PATIENT'S ATTORNEY
  1.  W !
  1.  K DIC,DR,DIE,DA,DD,DO
  1.  S DA=AD1
  1.  S DA(1)=AD0
  1.  S DIE="^AUPNTPL("_DA(1)_",1,"
  1.  S DR="103"
  1.  D ^DIE
  1.  K DIC,DR,DIE,DA
  1.  Q
  1. NOTES ;NOTES
  1.  W !
  1.  K DIC,DR,DIE,DA,DD,DO
  1.  S DA=AD1
  1.  S DA(1)=AD0
  1.  S DIE="^AUPNTPL("_DA(1)_",1,"
  1.  S DR="106"
  1.  W $$NOTELINE^AGUTILS(DR,9000041.0101,AD1_","_AD0_",",45)
  1.  D ^DIE
  1.  K DIC,DR,DIE,DA
  1.  Q
  1.  ; ****************************************************************
  1.  ; ON LINES BELOW:
  1.  ; PIECE 1= FIELD CAP
  1.  ;          IF THIS IS FILLED IN IT WILL BE USED AS THE CAP ON THE SCREEN
  1.  ;          IF IT IS NOT THEN THE FLD LBL FROM THE DD WILL BE USED
  1.  ; PIECE 2= POSITION ON LINE TO DISP FLD CAP
  1.  ; PIECE 3= FILE #
  1.  ; PIECE 4= FLD #
  1.  ; PIECE 5 - NEW LINE OR NOT
  1.  ;
  1. 1 ;
  1.  ;;TPL INJURY DATE^?4^9000041.0101^.01^!
  1.  ;;CAUSE^?16^9000041.0101^104^?40
  1.  ;;DESCRIPTION....^?4^9000041.0101^105^!
  1.  ;;NAME...........^?4^9000041.0101^101^!
  1.  ;;SOCIAL SECURITY NO^?49^9000041.0101^102^?46
  1.  ;;INSURANCE COVERAGE^?4^9000041.0101^.02^!
  1.  ;;EFFECTIVE DATE.^?4^9000041.0101^.04^!
  1.  ;;ENDING DATE.^?16^9000041.0101^.05^?40
  1.  ;;GROUP NAME.....^?4^9000041.0101^.06^!
  1.  ;;POLICY NUMBER..^?4^9000041.0101^.03^!
  1.  ;;PATIENT'S ATTORNEY^?42^9000041.0101^103^?39
  1.  ;;CLAIM #^?4^9000041.0101^201^!
  1.  ;;DATE LAST WORKED^?43^9000041.0101^202^?40
  1.  ;;DISABILITY START DATE^?4^9000041.0101^203^!
  1.  ;;DISABILITY END DATE^?44^9000041.0101^204^?40
  1.  ;;DATE AUTHORIZED RETURN TO WORK^?4^9000041.0101^205^!
  1.  ;;CONTACT INFO^?4^9000041.0101^206^!
  1.  ;;NOTES^?4^9000041.0101^106^!
  1.  ;;*END*