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

AGED4B.m

Go to the documentation of this file. 
  1. AGED4B ; IHS/ASDS/EFG - PAGE 5 - AUTO/LIABILITY, WORKMAN'S COMP PAGE ;    [ 05/13/2003  1:19 PM ]
  1.  ;;7.0;IHS PATIENT REGISTRATION;**1,2**;MAR 28, 2003
  1.  ;
  1.  S AG("N")=13
  1.  I '$D(AGAIN) D GETAW2
  1.  S AGAIN=""
  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.  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.  S AG("C")="DTACC,DESCAI,RESPINS,RESPSSN,POLNO,APATATTY,DTWC,DTCLOSE,DESCWI,EMPL,CLMFIL,CLMNO,WPATATTY"
  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.  D UPDATE1^AGED(DUZ(2),DFN,3,"")
  1.  K AGI,AGY
  1.  G VAR
  1. END K AG,DLOUT,DTOUT,DFOUT,DQOUT,DA,DIC,DR,AGSCRN,Y,ADA,WDA,ADT,WDT,ADFN,WDFN,REC
  1.  Q:$D(AGXTERN)
  1.  Q:$D(DIROUT)
  1.  Q:$D(AGSEENLY)
  1.  G ^AGED4A:$D(DUOUT)
  1.  G ^AGED13
  1.  Q
  1. DRAW ; EP
  1.  S AG("PG")=5
  1.  S DA=DFN
  1.  D ^AGED
  1.  K ^UTILITY("DIQ1",$J)
  1.  W !,"-- AUTO OR LIABILITY INSURANCE " F A=1:1:47 W "-"
  1.  D GETAW
  1.  Q
  1. GETAW2 ;
  1.  S (AD0,REC,ADFN)=""
  1.  F  S REC=$O(^AUPNAUTO("C",DFN,REC)) Q:'REC  D
  1.  . S ADFN=$P($G(^AUPNAUTO(REC,0)),U,2)
  1.  . I ADFN=DFN S AD0=REC
  1.  S (WD0,REC,WDFN)=""
  1.  F  S REC=$O(^AUPNWRKC("C",DFN,REC)) Q:'REC  D
  1.  . S WDFN=$P($G(^AUPNWRKC(REC,0)),U,2)
  1.  . I WDFN=DFN S WD0=REC
  1.  Q
  1.  ;
  1. GETAW ; GET LAST ENTRY FROM AUTO,LIAB/WC
  1.  F AG=1:1:13 D
  1.  . S AGSCRN=$P($T(@1+AG),";;",2,14)
  1.  . S DIC=$P(AGSCRN,U,3)
  1.  . S DR=$P(AGSCRN,U,4)
  1.  . I AG=7 W !,"-- WORKMAN'S COMPENSATION " F A=1:1:52 W "-"
  1.  . W !,AG,".",?(29-$L($P(^DD(DIC,DR,0),U))),$P(^DD(DIC,DR,0),U)," :  "
  1.  . I AG>0&(AG<7)&(AD0>0) S D0=AD0 W $$GET1^DIQ(DIC,D0,DR)
  1.  . I AG>6&(AG<14)&(WD0>0) S D0=WD0 W $$GET1^DIQ(DIC,D0,DR)
  1.  Q
  1. AMSG ; DISPLAY THIS MSG IF THERE NO ENTRY IN THE AUTO/LIAB
  1.  ; GLOBAL
  1.  W !,"You must first enter the DATE OF AUTO/LIAB INJURY"
  1.  Q
  1.  ;
  1. WMSG ; DISPLAY 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.  ;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1.  ; AUTO/LIAB ACCIDENT FIELDS
  1.  ;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1.  ;
  1. DTACC ; DATE OF AUTO/LIAB INJURY
  1.  W !
  1.  K DIC,DIE,DR,DA
  1.  S DIC="^AUPNAUTO("
  1.  S DLAYGO=9000031
  1.  S DIC(0)="AEMLQZ"
  1.  S DIC("S")="I $P(^(0),U,2)="_DFN
  1.  I AD0>0  D
  1.  . S Y=$P(^AUPNAUTO(AD0,0),U,1) D DD^%DT
  1.  . S DIC("B")=Y
  1.  K DD,DO
  1.  D ^DIC S AD0=+Y Q:+Y'>0
  1.  K DIC,DR,DIE
  1.  S DA=AD0
  1.  S DIE="^AUPNAUTO("
  1.  ;S DR=".01;.02///^S X=DFN"  ;IHS/SD/EFG  AG*7*2  #4
  1.  S DR=".01;.02////^S X=DFN"  ;IHS/SD/EFG  AG*7*2  #4
  1.  D ^DIE
  1.  K DIC,DR,DIE
  1.  Q
  1. DESCAI ; DESCRIPTION OF AUTO ACCIDENT INJURY
  1.  I '$D(^AUPNAUTO("C",DFN)) D AMSG H 2 D DRAW G DTACC
  1.  W !
  1.  K DIC,DR,DIE,DA,DD,DO
  1.  S DIE="^AUPNAUTO("
  1.  S DA=AD0
  1.  S DR=.03
  1.  D ^DIE
  1.  K DIC,DR,DIE,DA
  1.  Q
  1. RESPINS ; RESPONSIBLE PARTY INSURANCE COMPANY
  1.  I '$D(^AUPNAUTO("C",DFN)) D AMSG H 2 D DRAW G DTACC
  1.  W !
  1.  K DIC,DR,DIE,DA,DD,DO
  1.  S DIE="^AUPNAUTO("
  1.  S DA=AD0
  1.  S DR=.04
  1.  D ^DIE
  1.  K DIC,DR,DIE,DA
  1.  Q
  1. RESPSSN ; RESPONSIBLE PARTY SSN
  1.  I '$D(^AUPNAUTO("C",DFN)) D AMSG H 2 D DRAW G DTACC
  1.  W !
  1.  K DIC,DR,DIE,DA,DD,DO
  1.  S DIE="^AUPNAUTO("
  1.  S DA=AD0
  1.  S DR=.07
  1.  D ^DIE
  1.  K DIC,DR,DIE,DA
  1.  Q
  1. POLNO ; INSURANCE POLICY NUMBER
  1.  I '$D(^AUPNAUTO("C",DFN)) D AMSG H 2 D DRAW G DTACC
  1.  W !
  1.  K DIC,DR,DIE,DA,DD,DO
  1.  S DIE="^AUPNAUTO("
  1.  S DA=AD0
  1.  S DR=.05
  1.  D ^DIE
  1.  K DIC,DR,DIE,DA
  1.  Q
  1. APATATTY ; NAME OF PATIENT'S ATTORNEY FOR ACCIDENT/LIAB
  1.  I '$D(^AUPNAUTO("C",DFN)) D AMSG H 2 D DRAW G DTACC
  1.  W !
  1.  K DIC,DR,DIE,DA,DD,DO
  1.  S DIE="^AUPNAUTO("
  1.  S DA=AD0
  1.  S DR=.06
  1.  D ^DIE
  1.  K DIC,DR,DIE,DA
  1.  Q
  1.  ;
  1.  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1.  ; WORKMAN'S COMP INJURY FIELDS
  1.  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1.  ;
  1. DTWC ; DATE OF WORKMAN'S COMP INJURY
  1.  W !
  1.  K DIC,DIE,DR,DA
  1.  S DIC="^AUPNWRKC("
  1.  S DLAYGO=9000032
  1.  S DIC(0)="AEMLQZ"
  1.  S DIC("S")="I $P(^(0),U,2)="_DFN
  1.  I WD0>0  D
  1.  . S Y=$P(^AUPNWRKC(WD0,0),U,1) D DD^%DT
  1.  . S DIC("B")=Y
  1.  K DD,DO
  1.  D ^DIC S WD0=+Y Q:+Y'>0
  1.  K DIC,DR,DIE
  1.  S DA=WD0
  1.  S DIE="^AUPNWRKC("
  1.  ;S DR=".01;.02///^S X=DFN"  ;IHS/SD/EFG  AG*7*2  #4
  1.  S DR=".01;.02////^S X=DFN"  ;IHS/SD/EFG  AG*7*2  #4
  1.  D ^DIE
  1.  K DIC,DR,DIE
  1.  Q
  1. DTCLOSE ; DATE CASE CLOSED
  1.  I '$D(^AUPNWRKC("C",DFN)) D WMSG H 2 D DRAW G DTWC
  1.  K DIC,DR,DIE,DA,DD,DO
  1.  S DIE="^AUPNWRKC("
  1.  S DA=WD0
  1.  S DR=.08
  1.  D ^DIE
  1.  K DIC,DR,DIE,DA
  1.  Q
  1. DESCWI ; DESCRIPTION OF WORKMAN'S COMP INJURY
  1.  I '$D(^AUPNWRKC("C",DFN)) D WMSG H 2 D DRAW G DTWC
  1.  W !
  1.  K DIC,DR,DIE,DA,DD,DO
  1.  S DIE="^AUPNWRKC("
  1.  S DA=WD0
  1.  S DR=.03
  1.  D ^DIE
  1.  K DIC,DR,DIE,DA
  1.  Q
  1. CLMFIL ; WAS CLAIM FILED
  1.  I '$D(^AUPNWRKC("C",DFN)) D WMSG H 2 D DRAW G DTWC
  1.  W !
  1.  K DIC,DR,DIE,DA,DD,DO
  1.  S DIE="^AUPNWRKC("
  1.  S DA=WD0
  1.  S DR=.04
  1.  D ^DIE
  1.  K DIC,DR,DIE,DA
  1.  Q
  1. CLMNO ; CLAIM NUMBER
  1.  I '$D(^AUPNWRKC("C",DFN)) D WMSG H 2 D DRAW G DTWC
  1.  W !
  1.  K DIC,DR,DIE,DA,DD,DO
  1.  S DIE="^AUPNWRKC("
  1.  S DA=WD0
  1.  S DR=.05
  1.  D ^DIE
  1.  K DIC,DR,DIE,DA
  1.  Q
  1. WPATATTY ; NAME OF PATIENT'S ATTORNEY FOR WORKMAN'S COMP
  1.  I '$D(^AUPNWRKC("C",DFN)) D WMSG H 2 D DRAW G DTWC
  1.  W !
  1.  K DIC,DR,DIE,DA,DD,DO
  1.  S DIE="^AUPNWRKC("
  1.  S DA=WD0
  1.  S DR=.06
  1.  D ^DIE
  1.  K DIC,DR,DIE,DA
  1.  Q
  1. EMPL ; PATIENT'S EMPLOYER
  1.  I '$D(^AUPNWRKC("C",DFN)) D WMSG H 2 D DRAW G DTWC
  1.  W !
  1.  K DIC,DR,DIE,DA,DD,DO
  1.  S DIE="^AUPNWRKC("
  1.  S DA=WD0
  1.  S DR=.07
  1.  D ^DIE
  1.  K DIC,DR,DIE,DA
  1.  Q
  1.  ; *********************************************************************
  1.  ; ON LINES BELOW:
  1.  ; PIECE 1= FIELD LABEL
  1.  ; PIECE 2= POSITION ON LINE TO DISPLAY FIELD LABEL
  1.  ; PIECE 3= FILE NUMBER
  1.  ; PIECE 4= FIELD NUMBER
  1. 1 ;
  1.  ;;DATE OF ACCIDENT^24^9000031^.01
  1.  ;;DESCRIPTION OF INJURY^19^9000031^.03
  1.  ;;RESP. PARTY INS. CO.^20^9000031^.04
  1.  ;;RESP. PARTY SSN^25^9000031^.07
  1.  ;;POLICY NUMBER^27^9000031^.05
  1.  ;;NAME OF PT'S ATTORNEY^19^9000031^.06
  1.  ;;DATE OF INJURY^26^9000032^.01
  1.  ;;DATE CASE CLOSED^24^9000032^.08
  1.  ;;DESCRIPTION OF INJURY^19^9000032^.03
  1.  ;;EMPLOYER^32^9000032^.07
  1.  ;;WORKMAN'S COMP CLAIM FILED^14^9000032^.04
  1.  ;;CLAIM NUMBER^28^9000032^.05
  1.  ;;NAME OF PT'S ATTORNEY FOR THIS CASE^5^9000032^.06