- EASECSCC ;ALB/LBD,HM - LTC Co-Pay Test Screen Completion ;13 AUG 2001 ; 3/20/03 2:24pm
- ;;1.0;ENROLLMENT APPLICATION SYSTEM;**5,7,34,40,174**;Mar 15, 2001;Build 26
- ;
- ;NOTE: This routine was modified from DGMTSCC for LTC Co-pay
- ; Input -- DFN Patient IEN
- ; DGMTACT Menu Action
- ; DGMTDT Date of Test
- ; DGMTYPT Type of Test 3=LTC COPAY
- ; DGMTPAR Annual Means Test Parameters
- ; DGMTI Annual Means Test IEN
- ; DGVINI Veteran Individual Annual Income IEN
- ; DGVIRI Veteran Income Relation IEN
- ; DGVPRI Veteran Patient Relation IEN
- ; Output -- DGERR 1=INCOMPLETE and 0=COMPLETE
- ;
- EN N DGCAT,DGCOMF,DGDC,DGDET,DGIN0,DGIN1,DGIN2,DGINT,DGINTF,DGMTS,DGNC,DGND,DGNWT,DGNWTF,DGREF1,DGSP,DGTYC,DGTHA,DGTHB,DGVIR0,DGCOPS,DGCOST,DGRE,DGSTA,DGAGR
- S DGERR=0
- S DGCOMF=1 D DEP^EASECSU3,INC^EASECSU3
- ; If veteran's income is below the threshold then exempt from LTC copay
- ; LTC III (EAS*1*34) modified to make vet with $0 income exempt
- I DGINT'>+$$THRES^IBARXEU1(DGMTDT,1,0) D G Q
- .D EXMPT(DFN,DGMTI,12)
- .D PRT
- ; Check if test can be completed
- D CHK I DGERR W !?3,*7,"LTC copay test cannot be completed." G Q
- ; Did vet refuse to give income info
- I 'DGINTF,'DGNWTF S DGREF1="" D G Q:$D(DTOUT)!($D(DUOUT))
- .D REF
- .I $D(DGREF) S DGSTA="NON-EXEMPT"
- ; Get test status (Exempt or Non-Exempt)
- D STA G Q:$D(DTOUT)!($D(DUOUT))
- ; Does vet agree to pay co-payments
- I $G(DGSTA)="NON-EXEMPT" D AGREE G Q:$D(DTOUT)!($D(DUOUT))
- UPD S DA=DGMTI,DIE="^DGMT(408.31,",DIE("NO^")="",DR="[EASEC COMPLETE LTC CO-PAY TEST]" D ^DIE K DA,DIE,DR I '$D(DGFIN) S DGERR=1 G Q
- W !?3,"...The LTC copay test has been completed with a status of ",DGSTA,"..."
- D PRT
- ;
- Q K DGFIN,DGREF,DTOUT,DUOUT,Y
- Q
- ;
- COM ;Check if user wants to complete the LTC co-pay test
- N DIR
- S DIR("A")="Do you wish to complete the LTC copay test"
- S DIR("B")="YES",DIR(0)="Y" D ^DIR
- Q
- ;
- REF ;Check if patient declines to provide income information
- N DIR,Y
- S DIR("A")="Does veteran decline to give income information"
- I $P($G(^DGMT(408.31,DGMTI,0)),"^",14)]"" S DIR("B")=$$YN^DGMTSCU1($P(^(0),"^",14))
- S:'$D(DIR("B")) DIR("B")="NO"
- S DIR("?")="Answer 'Y' or 'N'."
- S DIR("?",1)="Enter whether the veteran declines to provide current income information."
- S DIR(0)="Y" D ^DIR K DIR G REFQ:$D(DTOUT)!($D(DUOUT))
- S:Y DGREF=""
- REFQ Q
- ;
- CHK ;Check if LTC copay test can be completed
- ; For LTC III (EAS*1*34) removed check if expenses greater than income
- N DGA,DGD,DGDEP,DGREL,DGL,DGM,I
- D GETREL^DGMTU11(DFN,"CS",$E(DGMTDT,1,3)_"0000",$S($G(DGMTI):DGMTI,1:""))
- S DGM=$P(DGVIR0,"^",14),DGL=$P(DGVIR0,"^",17),DGD=$P(DGVIR0,"^",8)
- I DGM="" W !?3,"Marital section must be completed." S DGERR=1
- ; For LTC IV (EAS*1*40) added check for legally separated
- I DGM,'DGL,'$D(DGREL("S")) W !?3,"Married is 'YES'. An active spouse for this LTC copay test does not exist." S DGERR=1
- I 'DGM,$D(DGREL("S")) W !?3,"An active spouse exists for this LTC copay test. Married should be 'YES'." S DGERR=1
- I DGD']"" W !?3,"Dependent Children section must be completed." S DGERR=1
- I DGD,'$D(DGREL("C")) W !?3,"Dependent Children is 'YES'. No active children exist." S DGERR=1
- I 'DGD,$D(DGREL("C")) W !?3,"Active children exist. Dependent Children should be 'YES'." S DGERR=1
- Q:$G(DGERR)
- N CNT,ACT,DGDEP,FLAG,DGINCP
- D INIT^EASECDEP S CNT=0 D
- .F S CNT=$O(DGDEP(CNT)) Q:'CNT I $P(DGDEP(CNT),U,2)="SPOUSE" D Q:$G(DGERR)
- ..D GETIENS^EASECU2(DFN,$P(DGDEP(CNT),U,20),DGMTDT)
- ..S DGINCP=$G(^DGMT(408.22,+DGIRI,"MT")) S:DGINCP FLAG=$G(FLAG)+1
- ..I $G(FLAG)>1 W !?3,"Patient has more than one spouse for this LTC copay test." S DGERR=1
- Q
- ;
- STA ;Ask test status
- N DIR,Y,SCRN,DGMOH
- S DGMTS=$P($G(^DGMT(408.31,DGMTI,0)),U,3)
- S DGRE=$P($G(^DGMT(408.31,DGMTI,2)),U,7)
- I DGMTS S DGSTA=$P($G(^DG(408.32,DGMTS,0)),U)
- I '$D(DGSTA) S DGSTA="NON-EXEMPT"
- I DGSTA="EXEMPT",("12"[DGRE),$G(DGINT)>+$$THRES^IBARXEU1(DGMTDT,1,0) S DGSTA="NON-EXEMPT"
- I DGSTA="EXEMPT",$G(DGNSTA)="NON-EXEMPT" S DGSTA="NON-EXEMPT"
- I DGSTA="NON-EXEMPT" D I DGMOH="Y" Q ;EAS*1.0*174 I NON-EXEMPT CHECK CHECK FOR MOH DATA AND DISPLAY MESSAGE
- .S DGMOH=$P($G(^DPT(DFN,.54)),U,1) I DGMOH="Y" W !!,"Veteran is Awarded Medal of Honor - Add a New LTC Copayment Test to update status" ;EAS*1.0*174 HM
- S DIR("A")="LTC Copay Test Status" S DIR("B")=DGSTA
- S DIR(0)="P^408.32:EM",DIR("S")="I $P(^(0),U,19)=3"
- D ^DIR K DIR Q:'Y!($D(DTOUT))!($D(DUOUT))
- S DGMTS=+Y,DGSTA=$P(Y,U,2) Q:DGSTA="NON-EXEMPT"
- ;If Exempt, ask reason for exemption
- S DIR("A")="Reason for Exemption"
- I DGRE S DIR("B")=$P($G(^EAS(714.1,DGRE,0)),U)
- ; Screen the look-up on file #714.1. Exemption reasons 1, 2 and 12
- ; will be screened out unless this is the call from the Edit option
- ; (DGEFLG=1) and only reason 1 is screened out. Reason 14 added for screening out EAS*1.0*174 HM
- S SCRN="2^12^14^" S:$G(DGEFLG) SCRN="" ;do not display 14 EAS*1.0*174 HM
- S DIR("S")="I $P(^(0),U,2),""^1^14"_SCRN_"""'[(U_Y_U)" ;do not display 14 EAS*1.0*174 HM
- S DIR(0)="P^714.1:EM" D ^DIR K DIR I 'Y!($D(DTOUT))!($D(DUOUT)) D G STA
- .W !!,"A reason for exemption must be entered for an Exempt status.",!
- S DGRE=+Y
- Q
- AGREE ;Ask if vet agrees to pay co-payment
- N DIR,Y
- S DIR("A")="Does the veteran agree to pay copayments"
- I $P($G(^DGMT(408.31,DGMTI,0)),U,11)]"" S DIR("B")=$$YN^DGMTSCU1($P(^(0),U,11))
- S:'$D(DIR("B")) DIR("B")="YES"
- S DIR("?")="Answer 'Y' or 'N'."
- S DIR("?",1)="Enter in this field whether the veteran agrees to pay the"
- S DIR("?",2)="LTC copayments. The veteran must also sign the 1010-EC form"
- S DIR("?",3)="agreeing to pay the copayments. If the veteran does not agree"
- S DIR("?",4)="to pay the copayments, the veteran becomes ineligible to"
- S DIR("?",5)="receive extended care services."
- S DIR(0)="Y" D ^DIR K DIR Q:$D(DTOUT)!($D(DUOUT))
- S DGAGR=Y
- Q
- PRT ;Print Extended Care Services test (1010EC)
- N DIR,Y,X,ZTSK
- S DIR("A")="PRINT 10-10EC"
- S DIR("B")="YES",DIR(0)="Y" D ^DIR G PRTQ:'Y!($D(DTOUT))!($D(DUOUT))
- S ZTSK=$$QUE^EASEC10E(DFN,DGMTI)
- PRTQ Q
- ;
- EXMPT(DFN,DGMTI,EX) ; Veteran is exempt from LTC co-payments
- ; Complete LTC co-pay test in Annual Means Test file (#408.31)
- ; Input -- DFN Patient IEN
- ; DGMTI Annual Means Test IEN
- ; EX Copay exemption code
- ; 1 = SC compensable disability
- ; 2 = NSC, single, receiving VA pension (no A&A, HB)
- ; or
- ; Income (last year) is below single pension threshold
- ; 12 = Income (current year) is below single pension threshold
- ; 14 = Veteran Awarded Medal of Honor - EAS*1.0*174 HM
- Q:'DGMTI Q:'EX
- N DATA,I
- W !! F I=1:1:80 W "="
- W !!,?10,"Veteran is EXEMPT from Long Term Care copayments."
- W !,?10,"Reason for Exemption: ",$P($G(^EAS(714.1,EX,0)),U)
- W !! F I=1:1:80 W "="
- W !!
- S DATA(.03)=$O(^DG(408.32,"C","X","")),DATA(2.07)=EX,DATA(.06)=DUZ
- S (DATA(.07),DATA(2.02))=$$NOW^XLFDT
- S DATA(.04)=$G(DGINT),DATA(.05)=$G(DGNWT),DATA(.15)=$G(DGDET)
- S DATA(.18)=$G(DGND),DATA(2.08)=$P($$GETLTC4^EASECMT(DFN),U,1)
- S DATA(.14)=$S($D(DGREF):1,1:0) ;LTC III (EAS*1*34)
- I $$UPD^DGENDBS(408.31,DGMTI,.DATA) Q
- W !,"ERROR: COULD NOT UPDATE LTC COPAY TEST",!!
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASECSCC 7431 printed Jan 18, 2025@02:55:29 Page 2
- EASECSCC ;ALB/LBD,HM - LTC Co-Pay Test Screen Completion ;13 AUG 2001 ; 3/20/03 2:24pm
- +1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**5,7,34,40,174**;Mar 15, 2001;Build 26
- +2 ;
- +3 ;NOTE: This routine was modified from DGMTSCC for LTC Co-pay
- +4 ; Input -- DFN Patient IEN
- +5 ; DGMTACT Menu Action
- +6 ; DGMTDT Date of Test
- +7 ; DGMTYPT Type of Test 3=LTC COPAY
- +8 ; DGMTPAR Annual Means Test Parameters
- +9 ; DGMTI Annual Means Test IEN
- +10 ; DGVINI Veteran Individual Annual Income IEN
- +11 ; DGVIRI Veteran Income Relation IEN
- +12 ; DGVPRI Veteran Patient Relation IEN
- +13 ; Output -- DGERR 1=INCOMPLETE and 0=COMPLETE
- +14 ;
- EN NEW DGCAT,DGCOMF,DGDC,DGDET,DGIN0,DGIN1,DGIN2,DGINT,DGINTF,DGMTS,DGNC,DGND,DGNWT,DGNWTF,DGREF1,DGSP,DGTYC,DGTHA,DGTHB,DGVIR0,DGCOPS,DGCOST,DGRE,DGSTA,DGAGR
- +1 SET DGERR=0
- +2 SET DGCOMF=1
- DO DEP^EASECSU3
- DO INC^EASECSU3
- +3 ; If veteran's income is below the threshold then exempt from LTC copay
- +4 ; LTC III (EAS*1*34) modified to make vet with $0 income exempt
- +5 IF DGINT'>+$$THRES^IBARXEU1(DGMTDT,1,0)
- Begin DoDot:1
- +6 DO EXMPT(DFN,DGMTI,12)
- +7 DO PRT
- End DoDot:1
- GOTO Q
- +8 ; Check if test can be completed
- +9 DO CHK
- IF DGERR
- WRITE !?3,*7,"LTC copay test cannot be completed."
- GOTO Q
- +10 ; Did vet refuse to give income info
- +11 IF 'DGINTF
- IF 'DGNWTF
- SET DGREF1=""
- Begin DoDot:1
- +12 DO REF
- +13 IF $DATA(DGREF)
- SET DGSTA="NON-EXEMPT"
- End DoDot:1
- if $DATA(DTOUT)!($DATA(DUOUT))
- GOTO Q
- +14 ; Get test status (Exempt or Non-Exempt)
- +15 DO STA
- if $DATA(DTOUT)!($DATA(DUOUT))
- GOTO Q
- +16 ; Does vet agree to pay co-payments
- +17 IF $GET(DGSTA)="NON-EXEMPT"
- DO AGREE
- if $DATA(DTOUT)!($DATA(DUOUT))
- GOTO Q
- UPD SET DA=DGMTI
- SET DIE="^DGMT(408.31,"
- SET DIE("NO^")=""
- SET DR="[EASEC COMPLETE LTC CO-PAY TEST]"
- DO ^DIE
- KILL DA,DIE,DR
- IF '$DATA(DGFIN)
- SET DGERR=1
- GOTO Q
- +1 WRITE !?3,"...The LTC copay test has been completed with a status of ",DGSTA,"..."
- +2 DO PRT
- +3 ;
- Q KILL DGFIN,DGREF,DTOUT,DUOUT,Y
- +1 QUIT
- +2 ;
- COM ;Check if user wants to complete the LTC co-pay test
- +1 NEW DIR
- +2 SET DIR("A")="Do you wish to complete the LTC copay test"
- +3 SET DIR("B")="YES"
- SET DIR(0)="Y"
- DO ^DIR
- +4 QUIT
- +5 ;
- REF ;Check if patient declines to provide income information
- +1 NEW DIR,Y
- +2 SET DIR("A")="Does veteran decline to give income information"
- +3 IF $PIECE($GET(^DGMT(408.31,DGMTI,0)),"^",14)]""
- SET DIR("B")=$$YN^DGMTSCU1($PIECE(^(0),"^",14))
- +4 if '$DATA(DIR("B"))
- SET DIR("B")="NO"
- +5 SET DIR("?")="Answer 'Y' or 'N'."
- +6 SET DIR("?",1)="Enter whether the veteran declines to provide current income information."
- +7 SET DIR(0)="Y"
- DO ^DIR
- KILL DIR
- if $DATA(DTOUT)!($DATA(DUOUT))
- GOTO REFQ
- +8 if Y
- SET DGREF=""
- REFQ QUIT
- +1 ;
- CHK ;Check if LTC copay test can be completed
- +1 ; For LTC III (EAS*1*34) removed check if expenses greater than income
- +2 NEW DGA,DGD,DGDEP,DGREL,DGL,DGM,I
- +3 DO GETREL^DGMTU11(DFN,"CS",$EXTRACT(DGMTDT,1,3)_"0000",$SELECT($GET(DGMTI):DGMTI,1:""))
- +4 SET DGM=$PIECE(DGVIR0,"^",14)
- SET DGL=$PIECE(DGVIR0,"^",17)
- SET DGD=$PIECE(DGVIR0,"^",8)
- +5 IF DGM=""
- WRITE !?3,"Marital section must be completed."
- SET DGERR=1
- +6 ; For LTC IV (EAS*1*40) added check for legally separated
- +7 IF DGM
- IF 'DGL
- IF '$DATA(DGREL("S"))
- WRITE !?3,"Married is 'YES'. An active spouse for this LTC copay test does not exist."
- SET DGERR=1
- +8 IF 'DGM
- IF $DATA(DGREL("S"))
- WRITE !?3,"An active spouse exists for this LTC copay test. Married should be 'YES'."
- SET DGERR=1
- +9 IF DGD']""
- WRITE !?3,"Dependent Children section must be completed."
- SET DGERR=1
- +10 IF DGD
- IF '$DATA(DGREL("C"))
- WRITE !?3,"Dependent Children is 'YES'. No active children exist."
- SET DGERR=1
- +11 IF 'DGD
- IF $DATA(DGREL("C"))
- WRITE !?3,"Active children exist. Dependent Children should be 'YES'."
- SET DGERR=1
- +12 if $GET(DGERR)
- QUIT
- +13 NEW CNT,ACT,DGDEP,FLAG,DGINCP
- +14 DO INIT^EASECDEP
- SET CNT=0
- Begin DoDot:1
- +15 FOR
- SET CNT=$ORDER(DGDEP(CNT))
- if 'CNT
- QUIT
- IF $PIECE(DGDEP(CNT),U,2)="SPOUSE"
- Begin DoDot:2
- +16 DO GETIENS^EASECU2(DFN,$PIECE(DGDEP(CNT),U,20),DGMTDT)
- +17 SET DGINCP=$GET(^DGMT(408.22,+DGIRI,"MT"))
- if DGINCP
- SET FLAG=$GET(FLAG)+1
- +18 IF $GET(FLAG)>1
- WRITE !?3,"Patient has more than one spouse for this LTC copay test."
- SET DGERR=1
- End DoDot:2
- if $GET(DGERR)
- QUIT
- End DoDot:1
- +19 QUIT
- +20 ;
- STA ;Ask test status
- +1 NEW DIR,Y,SCRN,DGMOH
- +2 SET DGMTS=$PIECE($GET(^DGMT(408.31,DGMTI,0)),U,3)
- +3 SET DGRE=$PIECE($GET(^DGMT(408.31,DGMTI,2)),U,7)
- +4 IF DGMTS
- SET DGSTA=$PIECE($GET(^DG(408.32,DGMTS,0)),U)
- +5 IF '$DATA(DGSTA)
- SET DGSTA="NON-EXEMPT"
- +6 IF DGSTA="EXEMPT"
- IF ("12"[DGRE)
- IF $GET(DGINT)>+$$THRES^IBARXEU1(DGMTDT,1,0)
- SET DGSTA="NON-EXEMPT"
- +7 IF DGSTA="EXEMPT"
- IF $GET(DGNSTA)="NON-EXEMPT"
- SET DGSTA="NON-EXEMPT"
- +8 ;EAS*1.0*174 I NON-EXEMPT CHECK CHECK FOR MOH DATA AND DISPLAY MESSAGE
- IF DGSTA="NON-EXEMPT"
- Begin DoDot:1
- +9 ;EAS*1.0*174 HM
- SET DGMOH=$PIECE($GET(^DPT(DFN,.54)),U,1)
- IF DGMOH="Y"
- WRITE !!,"Veteran is Awarded Medal of Honor - Add a New LTC Copayment Test to update status"
- End DoDot:1
- IF DGMOH="Y"
- QUIT
- +10 SET DIR("A")="LTC Copay Test Status"
- SET DIR("B")=DGSTA
- +11 SET DIR(0)="P^408.32:EM"
- SET DIR("S")="I $P(^(0),U,19)=3"
- +12 DO ^DIR
- KILL DIR
- if 'Y!($DATA(DTOUT))!($DATA(DUOUT))
- QUIT
- +13 SET DGMTS=+Y
- SET DGSTA=$PIECE(Y,U,2)
- if DGSTA="NON-EXEMPT"
- QUIT
- +14 ;If Exempt, ask reason for exemption
- +15 SET DIR("A")="Reason for Exemption"
- +16 IF DGRE
- SET DIR("B")=$PIECE($GET(^EAS(714.1,DGRE,0)),U)
- +17 ; Screen the look-up on file #714.1. Exemption reasons 1, 2 and 12
- +18 ; will be screened out unless this is the call from the Edit option
- +19 ; (DGEFLG=1) and only reason 1 is screened out. Reason 14 added for screening out EAS*1.0*174 HM
- +20 ;do not display 14 EAS*1.0*174 HM
- SET SCRN="2^12^14^"
- if $GET(DGEFLG)
- SET SCRN=""
- +21 ;do not display 14 EAS*1.0*174 HM
- SET DIR("S")="I $P(^(0),U,2),""^1^14"_SCRN_"""'[(U_Y_U)"
- +22 SET DIR(0)="P^714.1:EM"
- DO ^DIR
- KILL DIR
- IF 'Y!($DATA(DTOUT))!($DATA(DUOUT))
- Begin DoDot:1
- +23 WRITE !!,"A reason for exemption must be entered for an Exempt status.",!
- End DoDot:1
- GOTO STA
- +24 SET DGRE=+Y
- +25 QUIT
- AGREE ;Ask if vet agrees to pay co-payment
- +1 NEW DIR,Y
- +2 SET DIR("A")="Does the veteran agree to pay copayments"
- +3 IF $PIECE($GET(^DGMT(408.31,DGMTI,0)),U,11)]""
- SET DIR("B")=$$YN^DGMTSCU1($PIECE(^(0),U,11))
- +4 if '$DATA(DIR("B"))
- SET DIR("B")="YES"
- +5 SET DIR("?")="Answer 'Y' or 'N'."
- +6 SET DIR("?",1)="Enter in this field whether the veteran agrees to pay the"
- +7 SET DIR("?",2)="LTC copayments. The veteran must also sign the 1010-EC form"
- +8 SET DIR("?",3)="agreeing to pay the copayments. If the veteran does not agree"
- +9 SET DIR("?",4)="to pay the copayments, the veteran becomes ineligible to"
- +10 SET DIR("?",5)="receive extended care services."
- +11 SET DIR(0)="Y"
- DO ^DIR
- KILL DIR
- if $DATA(DTOUT)!($DATA(DUOUT))
- QUIT
- +12 SET DGAGR=Y
- +13 QUIT
- PRT ;Print Extended Care Services test (1010EC)
- +1 NEW DIR,Y,X,ZTSK
- +2 SET DIR("A")="PRINT 10-10EC"
- +3 SET DIR("B")="YES"
- SET DIR(0)="Y"
- DO ^DIR
- if 'Y!($DATA(DTOUT))!($DATA(DUOUT))
- GOTO PRTQ
- +4 SET ZTSK=$$QUE^EASEC10E(DFN,DGMTI)
- PRTQ QUIT
- +1 ;
- EXMPT(DFN,DGMTI,EX) ; Veteran is exempt from LTC co-payments
- +1 ; Complete LTC co-pay test in Annual Means Test file (#408.31)
- +2 ; Input -- DFN Patient IEN
- +3 ; DGMTI Annual Means Test IEN
- +4 ; EX Copay exemption code
- +5 ; 1 = SC compensable disability
- +6 ; 2 = NSC, single, receiving VA pension (no A&A, HB)
- +7 ; or
- +8 ; Income (last year) is below single pension threshold
- +9 ; 12 = Income (current year) is below single pension threshold
- +10 ; 14 = Veteran Awarded Medal of Honor - EAS*1.0*174 HM
- +11 if 'DGMTI
- QUIT
- if 'EX
- QUIT
- +12 NEW DATA,I
- +13 WRITE !!
- FOR I=1:1:80
- WRITE "="
- +14 WRITE !!,?10,"Veteran is EXEMPT from Long Term Care copayments."
- +15 WRITE !,?10,"Reason for Exemption: ",$PIECE($GET(^EAS(714.1,EX,0)),U)
- +16 WRITE !!
- FOR I=1:1:80
- WRITE "="
- +17 WRITE !!
- +18 SET DATA(.03)=$ORDER(^DG(408.32,"C","X",""))
- SET DATA(2.07)=EX
- SET DATA(.06)=DUZ
- +19 SET (DATA(.07),DATA(2.02))=$$NOW^XLFDT
- +20 SET DATA(.04)=$GET(DGINT)
- SET DATA(.05)=$GET(DGNWT)
- SET DATA(.15)=$GET(DGDET)
- +21 SET DATA(.18)=$GET(DGND)
- SET DATA(2.08)=$PIECE($$GETLTC4^EASECMT(DFN),U,1)
- +22 ;LTC III (EAS*1*34)
- SET DATA(.14)=$SELECT($DATA(DGREF):1,1:0)
- +23 IF $$UPD^DGENDBS(408.31,DGMTI,.DATA)
- QUIT
- +24 WRITE !,"ERROR: COULD NOT UPDATE LTC COPAY TEST",!!
- +25 QUIT