EASECU23 ;ALB/PHH,LBD - Display LTC Co-Pay test information; 17 AUG 2001
;;1.0;ENROLLMENT APPLICATION SYSTEM;**5,7,34**;Mar 15, 2001
;
DISPLAY(DGMTI,DGMTYPT) ;Display LTC Co-Pay test data
; Input: DGMTI - IEN of LTC Co-Pay
; DGMTYPT - Type of Test
; Output: None
N DGFCOL,DGSCOL,DGMTDIS,DGMTWP,WP,X,X1,Y,Z,DGSOURCE
S (DGMTWP,WP)=0,DGFCOL=24,DGSCOL=65
S DGMTDIS=^DGMT(408.31,DGMTI,0) I $D(^("C")) F S DGMTWP=$O(^DGMT(408.31,DGMTI,"C",DGMTWP)) Q:'DGMTWP S DGMTDIS(DGMTWP)=^(DGMTWP,0)
S X="",X=$$SETSTR^VALM1("Patient:",X,15,8)
S X=$$SETSTR^VALM1($P(^DPT($P(DGMTDIS,U,2),0),U),X,DGFCOL,25)
S X=$$SETSTR^VALM1("Date of Test:",X,51,13)
S X=$$SETSTR^VALM1($$FTIME^DGMTUTL($P(DGMTDIS,U)),X,DGSCOL,15)
W !!,X
S X="",X=$$SETSTR^VALM1("Total Dependents:",X,6,17)
S X=$$SETSTR^VALM1($P(DGMTDIS,U,18),X,DGFCOL,25)
S X=$$SETSTR^VALM1("Type Of Test:",X,51,13)
S X=$$SETSTR^VALM1($P($G(^DG(408.33,+$P(DGMTDIS,U,19),0)),U),X,DGSCOL,15)
W !,X
S X="",X=$$SETSTR^VALM1("Status:",X,16,7)
S X=$$SETSTR^VALM1($S($P(DGMTDIS,U,3)'="":$P(^DG(408.32,$P(DGMTDIS,U,3),0),U),1:"In Process"),X,DGFCOL,25)
S X=$$SETSTR^VALM1("Date/Time Completed:",X,44,20)
S X=$$SETSTR^VALM1($S($P(DGMTDIS,U,7)'="":$$FTIME^DGMTUTL($P(DGMTDIS,U,7)),1:""),X,DGSCOL,15)
W !,X
I $P(DGMTDIS,U,3)=12 D
.N EXERSN
.S X="",X=$$SETSTR^VALM1("Reason:",X,16,7),EXERSN=$P($G(^DGMT(408.31,DGMTI,2)),U,7)
.S X=$$SETSTR^VALM1($S(EXERSN'="":$P(^EAS(714.1,EXERSN,0),"^"),1:""),X,DGFCOL,56)
.W !,X
S X="",X=$$SETSTR^VALM1("Source Of Test:",X,49,15)
S DGSOURCE=$$SR^DGMTAUD1(DGMTDIS)
I DGSOURCE="OTHER FACILITY" S DGSOURCE=$P($G(^DGMT(408.31,DGMTI,2)),"^",5)
S X=$$SETSTR^VALM1(DGSOURCE,X,DGSCOL,15)
W !,X
S X="",X=$$SETSTR^VALM1("Income:",X,16,7)
S X=$$SETSTR^VALM1($S($P(DGMTDIS,U,4)'="":"$"_$P(DGMTDIS,U,4),1:""),X,DGFCOL,25)
S X=$$SETSTR^VALM1("Completed By:",X,51,13)
S X=$$SETSTR^VALM1($P($G(^VA(200,+$P(DGMTDIS,U,6),0)),U),X,DGSCOL,15)
W !,X
S X="",X=$$SETSTR^VALM1("Assets:",X,16,7)
S X=$$SETSTR^VALM1($S($P(DGMTDIS,U,5)'="":"$"_$P(DGMTDIS,U,5),1:""),X,DGFCOL,25)
W !,X
S X="",X=$$SETSTR^VALM1("Deductible Expenses:",X,3,20)
S X=$$SETSTR^VALM1($S($P(DGMTDIS,U,15)'="":"$"_$P(DGMTDIS,U,15),1:""),X,DGFCOL,25)
W !,X
S X=""
S X=$$SETSTR^VALM1("Declines Income Info:",X,2,21)
S X=$$SETSTR^VALM1($S($P(DGMTDIS,U,14)=1:"YES",$P(DGMTDIS,U,14)=0:"NO",1:""),X,DGFCOL,25)
S X=$$SETSTR^VALM1("Agrees to Pay Copayments:",X,39,25)
S X=$$SETSTR^VALM1($S($P(DGMTDIS,U,11)=1:"YES",$P(DGMTDIS,U,11)=0:"NO *INELIGIBLE*",1:""),X,DGSCOL,15)
W !,X
S (X,Y)=""
I $G(^DGMT(408.31,DGMTI,"PURGE"))'="" D
.S X=$$SETSTR^VALM1("Income Data Purged:",X,45,19)
.S X1=^DGMT(408.31,DGMTI,"PURGE")
.S X=$$SETSTR^VALM1($$FTIME^DGMTUTL(X1),X,DGSCOL,15)
W !,X
;
S (X,Y,Z)=""
W !,"Comment(s):" F S WP=$O(DGMTDIS(WP)) Q:'WP D
.W !,DGMTDIS(WP)
W !
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASECU23 2916 printed Nov 22, 2024@17:04:29 Page 2
EASECU23 ;ALB/PHH,LBD - Display LTC Co-Pay test information; 17 AUG 2001
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**5,7,34**;Mar 15, 2001
+2 ;
DISPLAY(DGMTI,DGMTYPT) ;Display LTC Co-Pay test data
+1 ; Input: DGMTI - IEN of LTC Co-Pay
+2 ; DGMTYPT - Type of Test
+3 ; Output: None
+4 NEW DGFCOL,DGSCOL,DGMTDIS,DGMTWP,WP,X,X1,Y,Z,DGSOURCE
+5 SET (DGMTWP,WP)=0
SET DGFCOL=24
SET DGSCOL=65
+6 SET DGMTDIS=^DGMT(408.31,DGMTI,0)
IF $DATA(^("C"))
FOR
SET DGMTWP=$ORDER(^DGMT(408.31,DGMTI,"C",DGMTWP))
if 'DGMTWP
QUIT
SET DGMTDIS(DGMTWP)=^(DGMTWP,0)
+7 SET X=""
SET X=$$SETSTR^VALM1("Patient:",X,15,8)
+8 SET X=$$SETSTR^VALM1($PIECE(^DPT($PIECE(DGMTDIS,U,2),0),U),X,DGFCOL,25)
+9 SET X=$$SETSTR^VALM1("Date of Test:",X,51,13)
+10 SET X=$$SETSTR^VALM1($$FTIME^DGMTUTL($PIECE(DGMTDIS,U)),X,DGSCOL,15)
+11 WRITE !!,X
+12 SET X=""
SET X=$$SETSTR^VALM1("Total Dependents:",X,6,17)
+13 SET X=$$SETSTR^VALM1($PIECE(DGMTDIS,U,18),X,DGFCOL,25)
+14 SET X=$$SETSTR^VALM1("Type Of Test:",X,51,13)
+15 SET X=$$SETSTR^VALM1($PIECE($GET(^DG(408.33,+$PIECE(DGMTDIS,U,19),0)),U),X,DGSCOL,15)
+16 WRITE !,X
+17 SET X=""
SET X=$$SETSTR^VALM1("Status:",X,16,7)
+18 SET X=$$SETSTR^VALM1($SELECT($PIECE(DGMTDIS,U,3)'="":$PIECE(^DG(408.32,$PIECE(DGMTDIS,U,3),0),U),1:"In Process"),X,DGFCOL,25)
+19 SET X=$$SETSTR^VALM1("Date/Time Completed:",X,44,20)
+20 SET X=$$SETSTR^VALM1($SELECT($PIECE(DGMTDIS,U,7)'="":$$FTIME^DGMTUTL($PIECE(DGMTDIS,U,7)),1:""),X,DGSCOL,15)
+21 WRITE !,X
+22 IF $PIECE(DGMTDIS,U,3)=12
Begin DoDot:1
+23 NEW EXERSN
+24 SET X=""
SET X=$$SETSTR^VALM1("Reason:",X,16,7)
SET EXERSN=$PIECE($GET(^DGMT(408.31,DGMTI,2)),U,7)
+25 SET X=$$SETSTR^VALM1($SELECT(EXERSN'="":$PIECE(^EAS(714.1,EXERSN,0),"^"),1:""),X,DGFCOL,56)
+26 WRITE !,X
End DoDot:1
+27 SET X=""
SET X=$$SETSTR^VALM1("Source Of Test:",X,49,15)
+28 SET DGSOURCE=$$SR^DGMTAUD1(DGMTDIS)
+29 IF DGSOURCE="OTHER FACILITY"
SET DGSOURCE=$PIECE($GET(^DGMT(408.31,DGMTI,2)),"^",5)
+30 SET X=$$SETSTR^VALM1(DGSOURCE,X,DGSCOL,15)
+31 WRITE !,X
+32 SET X=""
SET X=$$SETSTR^VALM1("Income:",X,16,7)
+33 SET X=$$SETSTR^VALM1($SELECT($PIECE(DGMTDIS,U,4)'="":"$"_$PIECE(DGMTDIS,U,4),1:""),X,DGFCOL,25)
+34 SET X=$$SETSTR^VALM1("Completed By:",X,51,13)
+35 SET X=$$SETSTR^VALM1($PIECE($GET(^VA(200,+$PIECE(DGMTDIS,U,6),0)),U),X,DGSCOL,15)
+36 WRITE !,X
+37 SET X=""
SET X=$$SETSTR^VALM1("Assets:",X,16,7)
+38 SET X=$$SETSTR^VALM1($SELECT($PIECE(DGMTDIS,U,5)'="":"$"_$PIECE(DGMTDIS,U,5),1:""),X,DGFCOL,25)
+39 WRITE !,X
+40 SET X=""
SET X=$$SETSTR^VALM1("Deductible Expenses:",X,3,20)
+41 SET X=$$SETSTR^VALM1($SELECT($PIECE(DGMTDIS,U,15)'="":"$"_$PIECE(DGMTDIS,U,15),1:""),X,DGFCOL,25)
+42 WRITE !,X
+43 SET X=""
+44 SET X=$$SETSTR^VALM1("Declines Income Info:",X,2,21)
+45 SET X=$$SETSTR^VALM1($SELECT($PIECE(DGMTDIS,U,14)=1:"YES",$PIECE(DGMTDIS,U,14)=0:"NO",1:""),X,DGFCOL,25)
+46 SET X=$$SETSTR^VALM1("Agrees to Pay Copayments:",X,39,25)
+47 SET X=$$SETSTR^VALM1($SELECT($PIECE(DGMTDIS,U,11)=1:"YES",$PIECE(DGMTDIS,U,11)=0:"NO *INELIGIBLE*",1:""),X,DGSCOL,15)
+48 WRITE !,X
+49 SET (X,Y)=""
+50 IF $GET(^DGMT(408.31,DGMTI,"PURGE"))'=""
Begin DoDot:1
+51 SET X=$$SETSTR^VALM1("Income Data Purged:",X,45,19)
+52 SET X1=^DGMT(408.31,DGMTI,"PURGE")
+53 SET X=$$SETSTR^VALM1($$FTIME^DGMTUTL(X1),X,DGSCOL,15)
End DoDot:1
+54 WRITE !,X
+55 ;
+56 SET (X,Y,Z)=""
+57 WRITE !,"Comment(s):"
FOR
SET WP=$ORDER(DGMTDIS(WP))
if 'WP
QUIT
Begin DoDot:1
+58 WRITE !,DGMTDIS(WP)
End DoDot:1
+59 WRITE !
+60 QUIT
