DGMTHL1 ;ALB/CJM/TDM,LBD,HM - Hardship Determinations - Build List Area;13 JUN 1997 08:00 am ;4/27/20 8:41am
;;5.3;Registration;**182,456,536,858,996,997**;08/13/93;Build 42
;
EN(DGARY,HARDSHIP,DGCNT) ;Entry point to build list area
; Input;
; DGARY Global array subscript
; HARDSHIP - hardship array (pass by reference)
; Output -- DGCNT Number of lines in the list
;
N DGLINE
S DGLINE=1,DGCNT=0
D SET(DGARY,.HARDSHIP,.DGLINE,.DGCNT)
Q
;
SET(DGARY,HARDSHIP,DGLINE,DGCNT) ;
;Description: Writes hardship
; Input -- DGARY Global array subscript
; HARDSHIP Hardship array
; DGLINE Line number
; Output -- DGCNT Number of lines in the list
N DGSTART,LINE
;
S DGSTART=DGLINE ; starting line number
D SET^DGENL1(DGARY,DGLINE,"Hardship",21,IORVON,IORVOFF,,,,.DGCNT)
S DGLINE=DGLINE+1
D SET^DGENL1(DGARY,DGLINE,$J("Current Means Test Status: ",31)_$$EXT^DGMTH("CURRENT STATUS",HARDSHIP("CURRENT STATUS")),1,,,,,,.DGCNT)
S DGLINE=DGLINE+1
D SET^DGENL1(DGARY,DGLINE,$J("Income Year: ",31)_$S(HARDSHIP("YEAR"):$$EXT^DGMTH("YEAR",HARDSHIP("YEAR")),1:""),1,,,,,,.DGCNT)
S DGLINE=DGLINE+1
D SET^DGENL1(DGARY,DGLINE,$J("Means Test Date: ",31)_$$EXT^DGMTH("TEST DATE",HARDSHIP("TEST DATE")),1,,,,,,.DGCNT)
S DGLINE=DGLINE+1
I (HARDSHIP("AGREE")'="") D SET^DGENL1(DGARY,DGLINE,$J("Agreed To Pay Deductible: ",31)_$$EXT^DGMTH("AGREE",HARDSHIP("AGREE")),1,,,,,,.DGCNT) S DGLINE=DGLINE+1
;
S DGLINE=DGLINE+1
I HARDSHIP("EXPIRATION")'="",HARDSHIP("EFFECTIVE")<=HARDSHIP("EXPIRATION"),HARDSHIP("EXPIRATION")<=DT D ;DG*5.3*997
.D SET^DGENL1(DGARY,DGLINE,$J("Hardship?: ",31)_"EXPIRED",1,,,,,,.DGCNT) ;DG*5.3*997
E D SET^DGENL1(DGARY,DGLINE,$J("Hardship?: ",31)_$$EXT^DGMTH("HARDSHIP?",HARDSHIP("HARDSHIP?")),1,,,,,,.DGCNT) ;DG*5.3*997
S DGLINE=DGLINE+1
D SET^DGENL1(DGARY,DGLINE,$J("Hardship Effective Date: ",31)_$$EXT^DGMTH("EFFECTIVE",HARDSHIP("EFFECTIVE")),1,,,,,,.DGCNT)
S DGLINE=DGLINE+1
D SET^DGENL1(DGARY,DGLINE,$J("Review Date: ",31)_$$EXT^DGMTH("REVIEW",HARDSHIP("REVIEW")),1,,,,,,.DGCNT)
S DGLINE=DGLINE+1
D SET^DGENL1(DGARY,DGLINE,$J("Hardship Expiration Date: ",31)_$$EXT^DGMTH("EXPIRATION",HARDSHIP("EXPIRATION")),1,,,,,,.DGCNT) ;DG*5.3*997
S DGLINE=DGLINE+1
D SET^DGENL1(DGARY,DGLINE,$J("Site Granting Hardship: ",31)_$$EXT^DGMTH("SITE",HARDSHIP("SITE")),1,,,,,,.DGCNT)
S DGLINE=DGLINE+1 ;DG*5.3*997
D SET^DGENL1(DGARY,DGLINE,$J("Approved By: ",31)_$$EXT^DGMTH("BY",HARDSHIP("BY")),1,,,,,,.DGCNT)
S DGLINE=DGLINE+1
D SET^DGENL1(DGARY,DGLINE,$J("Hardship Reason: ",31)_$$EXT^DGMTH("REASON",HARDSHIP("REASON")),1,,,,,,.DGCNT)
S DGLINE=DGLINE+2
;
D SET^DGENL1(DGARY,DGLINE,$J("Date Category Last Changed: ",31)_$$EXT^DGMTH("DT/TM CTGRY CHNGD",HARDSHIP("DT/TM CTGRY CHNGD")),1,,,,,,.DGCNT)
S DGLINE=DGLINE+1
D SET^DGENL1(DGARY,DGLINE,$J("Category Last Changed By: ",31)_$$EXT^DGMTH("CTGRY CHNGD BY",HARDSHIP("CTGRY CHNGD BY")),1,,,,,,.DGCNT)
S DGLINE=DGLINE+1
I $D(^DGMT(408.31,HARDSHIP("MTIEN"),"C")) D
.N LINE
.D SET^DGENL1(DGARY,DGLINE,"COMMENTS:",1,$G(IOINHI),$G(IOINORM),,,,.DGCNT)
.S DGLINE=DGLINE+1
.S LINE=0
.F S LINE=$O(^DGMT(408.31,HARDSHIP("MTIEN"),"C",LINE)) Q:'LINE D
..D SET^DGENL1(DGARY,DGLINE,$G(^DGMT(408.31,HARDSHIP("MTIEN"),"C",LINE,0)),1,,,,,,.DGCNT)
..S DGLINE=DGLINE+1
Q
;
CHKADD(HARDSHIP) ;
;Determines whether granting a hardship is appropriate
;Input:
; HARDSHIP - hardship array (pass by reference)
;Output:
; Function Value - 1 if the hardship can be granted, 0 otherwise
;
; Add check for MT more than a year old (DG*5.3*858)
I $G(HARDSHIP("TEST DATE")),$$OLD^DGMTU4(HARDSHIP("TEST DATE")) Q 0
;
N CODE
S CODE=""
S CODE=$$GETCODE^DGMTH(HARDSHIP("CURRENT STATUS"))
I CODE'="C",CODE'="G" Q 0 ;Remove pending adjudication DG*5.3*997
I CODE="C"!(CODE="G"),HARDSHIP("EXPIRATION")'="",HARDSHIP("EFFECTIVE")<=HARDSHIP("EXPIRATION"),HARDSHIP("EXPIRATION")<=DT Q 0 ;if hardship expired cannot add DG*5.3*997
Q 1
;
ADD(HARDSHIP) ;
;Add hardship protocol.
;
;Input:
; HARDSHIP - hardship array, pass by reference
;Output:
; HARDSHIP - hardship array (pass by reference)
;
N CODE,ERROR
I $G(DUZ)'>1 W !,"YOUR DUZ IS NOT DEFINED!" D PAUSE^VALM1 S VALMBCK="R" Q
S CODE=""
S CODE=$$GETCODE^DGMTH(HARDSHIP("CURRENT STATUS"))
I CODE'="C",CODE'="P",CODE'="G" W !,"PATIENT NOT CURRENTLY RESPONSIBLE FOR COPAYMENT CHARGES!" D PAUSE^VALM1 Q
S HARDSHIP("EFFECTIVE")=DT
S HARDSHIP("SITE")=$$GETSITE^DGMTU4(.DUZ)
I HARDSHIP("TEST STATUS")="" S HARDSHIP("TEST STATUS")=HARDSHIP("CURRENT STATUS")
;S HARDSHIP("CURRENT STATUS")=$$GETSTAT^DGMTH("A",1)
S HARDSHIP("BY")=DUZ
S HARDSHIP("CTGRY CHNGD BY")=DUZ
S HARDSHIP("DT/TM CTGRY CHNGD")=$$NOW^XLFDT
S HARDSHIP("HARDSHIP?")=1
D
.I HARDSHIP("EXPIRATION") Q ;DG*5.3*997 CANNOT ADD WHEN EXPIRED HARDSHIP
.I '$$GETSTAT(.HARDSHIP) Q
.I '$$GETEFF(.HARDSHIP) Q
.;I '$$GETREV(.HARDSHIP) Q ;commented out per requirement DG*5.3*996
.D SETREV(.HARDSHIP) ;set review date to December 31 of current year DG*5.3*996
.I '$$GETREAS(.HARDSHIP) Q
.D PRIOR(.HARDSHIP)
.I $$STORE^DGMTH(.HARDSHIP,.ERROR) D
..N EVENTS
..S EVENTS("IVM")=1
..I $$LOG^IVMPLOG(HARDSHIP("DFN"),HARDSHIP("YEAR"),.EVENTS)
.E W !,$G(ERROR) D PAUSE^VALM1
.D AFTER(.HARDSHIP)
D INIT^DGMTHL
S VALMBCK="R"
Q
;
EDIT(HARDSHIP) ;
;Add hardship protocol.
;
;Input:
; HARDSHIP - hardship array, pass by reference
;Output:
; HARDSHIP - hardship array (pass by reference)
;
N ERROR,DGSRCTST ;DG*5.3*996
S DGSRCTST=$$GETSRC(HARDSHIP("MTIEN")) ;GET SRC OF TEST DATA DG*5.3*996
I DGSRCTST=3 D Q ;IF SRC OF TEST IS DCD (3) NO EDITING ALLOWED DG*5.3*996
.W !,"PLEASE USE ES TO EDIT HARDSHIP." D PAUSE^VALM1 Q ;DISPLAY MESSAGE TO NOTIFY USER DG*5.3*996
I HARDSHIP("SITE")="",DUZ=HARDSHIP("BY") S HARDSHIP("SITE")=+$$GETSITE^DGMTU4(DUZ) ;IF SITE GRANTING HARDSHIP IS EMPTY THEN IT IS A MANUAL ENTRY AND DGSITE AND HARDSHIP("SITE") ARE EQUAL DG*5.3*996
I +$$GETSITE^DGMTU4(DUZ)=+HARDSHIP("SITE"),$D(^XUSEC("DG MEANSTEST",DUZ)),DGSRCTST'=3 D ;DG*5.3*996
.I '$$GETSTAT(.HARDSHIP,1) Q
.I '$$GETEFF(.HARDSHIP) Q
.;I '$$GETREV(.HARDSHIP) Q ;commented out per requirement DG*5.3*996
.D SETREV(.HARDSHIP) ;set review date to December 31 of current year DG*5.3*996
.I '$$GETREAS(.HARDSHIP) Q
.D PRIOR(.HARDSHIP)
.I $$STORE^DGMTH(.HARDSHIP,.ERROR) D
..N EVENTS
..S EVENTS("IVM")=1
..I $$LOG^IVMPLOG(HARDSHIP("DFN"),HARDSHIP("YEAR"),.EVENTS)
.E W !,$G(ERROR) D PAUSE^VALM1
.D AFTER(.HARDSHIP)
D INIT^DGMTHL
S VALMBCK="R"
Q
;
CHKDEL(HARDSHIP) ;
;Checks whether the hardship can be deleted.
;Input:
; HARDSHIP - hardship array (pass by reference)
I (HARDSHIP("HARDSHIP?")="1"),(HARDSHIP("BY")!((+HARDSHIP("SITE")=+$$GETSITE^DGMTU4($G(DUZ))))) Q 1
Q 0
DELETE(HARDSHIP) ;
;Deletes the hardship.
;
;Input:
; HARDSHIP - hardship array (pass by reference)
;
N ERROR,DGSRCTST ;DG*5.3*996
S DGSRCTST=$$GETSRC(HARDSHIP("MTIEN")) ;GET SRC OF TEST DATA DG*5.3*996
I DGSRCTST=3 D Q ;IF SRC OF TEST IS DCD (3) NO EDITING ALLOWED DG*5.3*996
.W !,"PLEASE USE ES TO EDIT HARDSHIP." D PAUSE^VALM1 Q ;DISPLAY MESSAGE TO NOTIFY USER DG*5.3*996
I HARDSHIP("SITE")="",DUZ=HARDSHIP("BY") S HARDSHIP("SITE")=+$$GETSITE^DGMTU4(DUZ) ;IF SITE GRANTING HARDSHIP IS EMPTY THEN IT IS A MANUAL ENTRY AND DGSITE AND HARDSHIP("SITE") ARE EQUAL DG*5.3*996
I +$$GETSITE^DGMTU4(DUZ)=+HARDSHIP("SITE"),$D(^XUSEC("DG MEANSTEST",DUZ)),DGSRCTST'=3,HARDSHIP("EXPIRATION")="" D ;DG*5.3*996 ;DG*5.3*997 CANNOT DELETE EXPIRED HARDSHIP
.I $$RUSURE,'$$DELETE^DGMTH(.HARDSHIP,1,.ERROR) W !,"AN ERROR OCCURRED - "_$G(ERROR) D PAUSE^VALM1
.D INIT^DGMTHL
.S VALMBCK="R"
Q
;
GETSTAT(HARDSHIP,EDITFLG) ;
;Asks the user to enter the means test status.
;
;Input:
; HARDSHIP - hardship array (pass by reference)
; EDITFLG - Edit Flag: 1=Edit
;Output:
; HARDSHIP("CURRENT STATUS")
;
N DIR,FLTRSTAT
S FLTRSTAT=$$GETCODE^DGMTH($S($G(EDITFLG):HARDSHIP("TEST STATUS"),1:HARDSHIP("CURRENT STATUS")))
S DIR(0)="Pr^408.32:EMZ"
S DIR("S")="I $P(^(0),U,19)=1"
I "CP"[FLTRSTAT S DIR("S")=DIR("S")_",""AG""[$P(^(0),U,2)"
I FLTRSTAT="G" S DIR("S")=DIR("S")_",""A""[$P(^(0),U,2)"
S DIR("A")="Means Test Status"
S DIR("B")=$$EXT^DGMTH("CURRENT STATUS",HARDSHIP("CURRENT STATUS"))
D FULL^VALM1
D ^DIR
I $D(DIRUT) Q 0
I Y<1 Q 0
S HARDSHIP("CURRENT STATUS")=+Y
; Don't reset agreed to pay if mt copay req/GMT copay req/pend adj
S:"^C^G^P^"'[(U_$P($G(^DG(408.32,+Y,0)),U,2)_U) HARDSHIP("AGREE")=""
S VALMBCK="R"
Q 1
;
GETEFF(HARDSHIP) ;
;Asks the user to enter the effective date. Returns 1 on success, 0 on failure
;
;Input:
; HARDSHIP - hardship array (pass by reference)
;Output:
; HARDSHIP("EFFECTIVE")
;
N DIR
S DIR(0)="D^"_HARDSHIP("TEST DATE")_":"_DT_":EX"
S DIR("A")="Hardship Effective Date"
S DIR("B")=$$FMTE^XLFDT($S(HARDSHIP("EFFECTIVE"):HARDSHIP("EFFECTIVE"),1:HARDSHIP("TEST DATE")),"1D")
D ^DIR
I $D(DIRUT) Q 0
I Y<1 Q 0
S HARDSHIP("EFFECTIVE")=Y
Q 1
GETREV(HARDSHIP) ;
;Asks the user to enter the review date. Returns 1 on success, 0 on failure
;
;Input:
; HARDSHIP - hardship array (pass by reference)
;Output:
; HARDSHIP("REVIEW")
;
N RET,STOP,X,Y
S (STOP,RET)=0
S DIR(0)="DO^::EX"
S DIR("A")="Hardship Review Date"
I HARDSHIP("REVIEW") S DIR("B")=$$FMTE^XLFDT(HARDSHIP("REVIEW"),"1D")
S DIR("?")="Enter a future date if you wish to conduct a review."
F D Q:STOP
.N DIR
.S DIR(0)="DO^::EX"
.S DIR("A")="Hardship Review Date"
.I HARDSHIP("REVIEW") S DIR("B")=$$FMTE^XLFDT(HARDSHIP("REVIEW"),"1D")
.S DIR("?")="Enter a future date if you wish to conduct a review."
.D ^DIR
.I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) S STOP=1,RET=0 Q
.I X="@" S Y="",STOP=1,RET=1 Q
.I Y=-1 S STOP=1,RET=0 Q
.I Y<DT W !,DIR("?") Q
.S (STOP,RET)=1
S:RET HARDSHIP("REVIEW")=Y
Q RET
;
GETREAS(HARDSHIP) ;
;Asks the user to enter the hardship reason.
;
;Input:
; HARDSHIP - hardship array (pass by reference)
;Output
; HARDSHIP("REASON")
;
N DIR
S DIR(0)="FO^3:80"
S DIR("A")="Hardship Reason"
S DIR("B")=$G(HARDSHIP("REASON")) K:DIR("B")="" DIR("B")
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q 0
S HARDSHIP("REASON")=Y
Q 1
;
PRIOR(HARDSHIP) ;set up for means test event driver
S DFN=HARDSHIP("DFN")
S DGMTI=HARDSHIP("MTIEN")
S DGMTS=HARDSHIP("CURRENT STATUS")
S DGMTACT="CAT"
S DGMTYPT=1
D PRIOR^DGMTEVT
Q
AFTER(HARDSHIP) ;calls means test event driver
D AFTER^DGMTEVT
S DGMTINF=0
D EN^DGMTEVT
K DGMTA,DGMTACT,DGMTDT,DGMTI,DGMTINF,DGMTP,DGMTS,DGMTYPT,I,J,Y
Q
;Edit Comments protocol.
;
;Input:
; HARDSHIP - hardship array, pass by reference
;Output:
; none
;
N DA,DIE,DR
I $G(DUZ)'>1 W !,"YOUR DUZ IS NOT DEFINED!" D PAUSE^VALM1 S VALMBCK="R" Q
D FULL^VALM1
I $G(HARDSHIP("MTIEN")) S DR="50",DA=HARDSHIP("MTIEN"),DIE=408.31 D ^DIE
D INIT^DGMTHL
I VALMCNT<15 S VALMBG=1
S VALMBCK="R"
Q
;
RUSURE() ;
;Description: Asks user 'Are you sure?'
;Input: none
;Output: Function Value returns 0 or 1
;
N DIR
S DIR(0)="Y"
S DIR("A")="Are you sure that the hardship should be deleted"
S DIR("B")="NO"
D ^DIR
Q:$D(DIRUT) 0
Q Y
EXSURE() ;
;Description: Asks user 'Are you sure?'
;Input: none
;Output: Function Value returns 0 or 1
;
N DIR
S DIR(0)="Y"
S DIR("A")="Are you sure you want to Expire this Hardship? (enter yes or no) "
S DIR("B")="NO"
D ^DIR
Q:$D(DIRUT) 0
Q Y
SETREV(HARDSHIP) ;SET REVIEW DATE TO DEC 31 OF CURRENT YEAR SO THAT HARDSHIP WILL EXPIRE DECEMBER 31 11:59 PM OF CURRENT YEAR
;DG*5.3*996
N REVDT,REVDTYR,REVDTDIF ;DG*5.3*997
S REVDT=$E(DT,1,3),REVDT=REVDT_"1101",HARDSHIP("REVIEW")=REVDT ;DG*5.3*997 SET REVIEW DATE TO 60 DAY PRIOR
S REVDT=$E(DT,1,3),REVDT=REVDT_"1231",HARDSHIP("EXPIRATION")=REVDT ;DG*5.3*997 SET EXPIRATION DATE TO THE SAME
;IF HARDSHIP EXPIRATION DATE IS LESS THAN 60 DAYS TO TODAY SET HARDSHIP("REVIEW") DATE TO TODAY DG*5.3*997
S REVDTDIF=($$FMTH^XLFDT(HARDSHIP("EXPIRATION")))-($$FMTH^XLFDT(DT)) I REVDTDIF<60 S HARDSHIP("REVIEW")=DT ;DG*5.3*997
Q
;
SETREVEX(HARDSHIP) ;SET REVIEW DATE TO HARDSHIP EXPIRATION DATE ENTERED IN
;DG*5.3*997
N REVDT,REVDTYR
S REVDT=HARDSHIP("EXPIRATION")
Q
;
GETSRC(MTIEN) ; GET SOURCE OF TEST DATA TO DETERMINE IF FROM DCD ;DG*5.3*996
N RET,NODE0
S NODE0=$G(^DGMT(408.31,MTIEN,0))
S RET=$P(NODE0,"^",23)
Q RET
;
HRDSHPR ; RESPONSE FOR HARDSHIP EDIT OR DELETE
N MSG
S MSG="PLEASE USE ES TO EDIT HARDSHIP"
Q MSG
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMTHL1 12734 printed Apr 09, 2024@21:40:49 Page 2
DGMTHL1 ;ALB/CJM/TDM,LBD,HM - Hardship Determinations - Build List Area;13 JUN 1997 08:00 am ;4/27/20 8:41am
+1 ;;5.3;Registration;**182,456,536,858,996,997**;08/13/93;Build 42
+2 ;
EN(DGARY,HARDSHIP,DGCNT) ;Entry point to build list area
+1 ; Input;
+2 ; DGARY Global array subscript
+3 ; HARDSHIP - hardship array (pass by reference)
+4 ; Output -- DGCNT Number of lines in the list
+5 ;
+6 NEW DGLINE
+7 SET DGLINE=1
SET DGCNT=0
+8 DO SET(DGARY,.HARDSHIP,.DGLINE,.DGCNT)
+9 QUIT
+10 ;
SET(DGARY,HARDSHIP,DGLINE,DGCNT) ;
+1 ;Description: Writes hardship
+2 ; Input -- DGARY Global array subscript
+3 ; HARDSHIP Hardship array
+4 ; DGLINE Line number
+5 ; Output -- DGCNT Number of lines in the list
+6 NEW DGSTART,LINE
+7 ;
+8 ; starting line number
SET DGSTART=DGLINE
+9 DO SET^DGENL1(DGARY,DGLINE,"Hardship",21,IORVON,IORVOFF,,,,.DGCNT)
+10 SET DGLINE=DGLINE+1
+11 DO SET^DGENL1(DGARY,DGLINE,$JUSTIFY("Current Means Test Status: ",31)_$$EXT^DGMTH("CURRENT STATUS",HARDSHIP("CURRENT STATUS")),1,,,,,,.DGCNT)
+12 SET DGLINE=DGLINE+1
+13 DO SET^DGENL1(DGARY,DGLINE,$JUSTIFY("Income Year: ",31)_$SELECT(HARDSHIP("YEAR"):$$EXT^DGMTH("YEAR",HARDSHIP("YEAR")),1:""),1,,,,,,.DGCNT)
+14 SET DGLINE=DGLINE+1
+15 DO SET^DGENL1(DGARY,DGLINE,$JUSTIFY("Means Test Date: ",31)_$$EXT^DGMTH("TEST DATE",HARDSHIP("TEST DATE")),1,,,,,,.DGCNT)
+16 SET DGLINE=DGLINE+1
+17 IF (HARDSHIP("AGREE")'="")
DO SET^DGENL1(DGARY,DGLINE,$JUSTIFY("Agreed To Pay Deductible: ",31)_$$EXT^DGMTH("AGREE",HARDSHIP("AGREE")),1,,,,,,.DGCNT)
SET DGLINE=DGLINE+1
+18 ;
+19 SET DGLINE=DGLINE+1
+20 ;DG*5.3*997
IF HARDSHIP("EXPIRATION")'=""
IF HARDSHIP("EFFECTIVE")<=HARDSHIP("EXPIRATION")
IF HARDSHIP("EXPIRATION")<=DT
Begin DoDot:1
+21 ;DG*5.3*997
DO SET^DGENL1(DGARY,DGLINE,$JUSTIFY("Hardship?: ",31)_"EXPIRED",1,,,,,,.DGCNT)
End DoDot:1
+22 ;DG*5.3*997
IF '$TEST
DO SET^DGENL1(DGARY,DGLINE,$JUSTIFY("Hardship?: ",31)_$$EXT^DGMTH("HARDSHIP?",HARDSHIP("HARDSHIP?")),1,,,,,,.DGCNT)
+23 SET DGLINE=DGLINE+1
+24 DO SET^DGENL1(DGARY,DGLINE,$JUSTIFY("Hardship Effective Date: ",31)_$$EXT^DGMTH("EFFECTIVE",HARDSHIP("EFFECTIVE")),1,,,,,,.DGCNT)
+25 SET DGLINE=DGLINE+1
+26 DO SET^DGENL1(DGARY,DGLINE,$JUSTIFY("Review Date: ",31)_$$EXT^DGMTH("REVIEW",HARDSHIP("REVIEW")),1,,,,,,.DGCNT)
+27 SET DGLINE=DGLINE+1
+28 ;DG*5.3*997
DO SET^DGENL1(DGARY,DGLINE,$JUSTIFY("Hardship Expiration Date: ",31)_$$EXT^DGMTH("EXPIRATION",HARDSHIP("EXPIRATION")),1,,,,,,.DGCNT)
+29 SET DGLINE=DGLINE+1
+30 DO SET^DGENL1(DGARY,DGLINE,$JUSTIFY("Site Granting Hardship: ",31)_$$EXT^DGMTH("SITE",HARDSHIP("SITE")),1,,,,,,.DGCNT)
+31 ;DG*5.3*997
SET DGLINE=DGLINE+1
+32 DO SET^DGENL1(DGARY,DGLINE,$JUSTIFY("Approved By: ",31)_$$EXT^DGMTH("BY",HARDSHIP("BY")),1,,,,,,.DGCNT)
+33 SET DGLINE=DGLINE+1
+34 DO SET^DGENL1(DGARY,DGLINE,$JUSTIFY("Hardship Reason: ",31)_$$EXT^DGMTH("REASON",HARDSHIP("REASON")),1,,,,,,.DGCNT)
+35 SET DGLINE=DGLINE+2
+36 ;
+37 DO SET^DGENL1(DGARY,DGLINE,$JUSTIFY("Date Category Last Changed: ",31)_$$EXT^DGMTH("DT/TM CTGRY CHNGD",HARDSHIP("DT/TM CTGRY CHNGD")),1,,,,,,.DGCNT)
+38 SET DGLINE=DGLINE+1
+39 DO SET^DGENL1(DGARY,DGLINE,$JUSTIFY("Category Last Changed By: ",31)_$$EXT^DGMTH("CTGRY CHNGD BY",HARDSHIP("CTGRY CHNGD BY")),1,,,,,,.DGCNT)
+40 SET DGLINE=DGLINE+1
+41 IF $DATA(^DGMT(408.31,HARDSHIP("MTIEN"),"C"))
Begin DoDot:1
+42 NEW LINE
+43 DO SET^DGENL1(DGARY,DGLINE,"COMMENTS:",1,$GET(IOINHI),$GET(IOINORM),,,,.DGCNT)
+44 SET DGLINE=DGLINE+1
+45 SET LINE=0
+46 FOR
SET LINE=$ORDER(^DGMT(408.31,HARDSHIP("MTIEN"),"C",LINE))
if 'LINE
QUIT
Begin DoDot:2
+47 DO SET^DGENL1(DGARY,DGLINE,$GET(^DGMT(408.31,HARDSHIP("MTIEN"),"C",LINE,0)),1,,,,,,.DGCNT)
+48 SET DGLINE=DGLINE+1
End DoDot:2
End DoDot:1
+49 QUIT
+50 ;
CHKADD(HARDSHIP) ;
+1 ;Determines whether granting a hardship is appropriate
+2 ;Input:
+3 ; HARDSHIP - hardship array (pass by reference)
+4 ;Output:
+5 ; Function Value - 1 if the hardship can be granted, 0 otherwise
+6 ;
+7 ; Add check for MT more than a year old (DG*5.3*858)
+8 IF $GET(HARDSHIP("TEST DATE"))
IF $$OLD^DGMTU4(HARDSHIP("TEST DATE"))
QUIT 0
+9 ;
+10 NEW CODE
+11 SET CODE=""
+12 SET CODE=$$GETCODE^DGMTH(HARDSHIP("CURRENT STATUS"))
+13 ;Remove pending adjudication DG*5.3*997
IF CODE'="C"
IF CODE'="G"
QUIT 0
+14 ;if hardship expired cannot add DG*5.3*997
IF CODE="C"!(CODE="G")
IF HARDSHIP("EXPIRATION")'=""
IF HARDSHIP("EFFECTIVE")<=HARDSHIP("EXPIRATION")
IF HARDSHIP("EXPIRATION")<=DT
QUIT 0
+15 QUIT 1
+16 ;
ADD(HARDSHIP) ;
+1 ;Add hardship protocol.
+2 ;
+3 ;Input:
+4 ; HARDSHIP - hardship array, pass by reference
+5 ;Output:
+6 ; HARDSHIP - hardship array (pass by reference)
+7 ;
+8 NEW CODE,ERROR
+9 IF $GET(DUZ)'>1
WRITE !,"YOUR DUZ IS NOT DEFINED!"
DO PAUSE^VALM1
SET VALMBCK="R"
QUIT
+10 SET CODE=""
+11 SET CODE=$$GETCODE^DGMTH(HARDSHIP("CURRENT STATUS"))
+12 IF CODE'="C"
IF CODE'="P"
IF CODE'="G"
WRITE !,"PATIENT NOT CURRENTLY RESPONSIBLE FOR COPAYMENT CHARGES!"
DO PAUSE^VALM1
QUIT
+13 SET HARDSHIP("EFFECTIVE")=DT
+14 SET HARDSHIP("SITE")=$$GETSITE^DGMTU4(.DUZ)
+15 IF HARDSHIP("TEST STATUS")=""
SET HARDSHIP("TEST STATUS")=HARDSHIP("CURRENT STATUS")
+16 ;S HARDSHIP("CURRENT STATUS")=$$GETSTAT^DGMTH("A",1)
+17 SET HARDSHIP("BY")=DUZ
+18 SET HARDSHIP("CTGRY CHNGD BY")=DUZ
+19 SET HARDSHIP("DT/TM CTGRY CHNGD")=$$NOW^XLFDT
+20 SET HARDSHIP("HARDSHIP?")=1
+21 Begin DoDot:1
+22 ;DG*5.3*997 CANNOT ADD WHEN EXPIRED HARDSHIP
IF HARDSHIP("EXPIRATION")
QUIT
+23 IF '$$GETSTAT(.HARDSHIP)
QUIT
+24 IF '$$GETEFF(.HARDSHIP)
QUIT
+25 ;I '$$GETREV(.HARDSHIP) Q ;commented out per requirement DG*5.3*996
+26 ;set review date to December 31 of current year DG*5.3*996
DO SETREV(.HARDSHIP)
+27 IF '$$GETREAS(.HARDSHIP)
QUIT
+28 DO PRIOR(.HARDSHIP)
+29 IF $$STORE^DGMTH(.HARDSHIP,.ERROR)
Begin DoDot:2
+30 NEW EVENTS
+31 SET EVENTS("IVM")=1
+32 IF $$LOG^IVMPLOG(HARDSHIP("DFN"),HARDSHIP("YEAR"),.EVENTS)
End DoDot:2
+33 IF '$TEST
WRITE !,$GET(ERROR)
DO PAUSE^VALM1
+34 DO AFTER(.HARDSHIP)
End DoDot:1
+35 DO INIT^DGMTHL
+36 SET VALMBCK="R"
+37 QUIT
+38 ;
EDIT(HARDSHIP) ;
+1 ;Add hardship protocol.
+2 ;
+3 ;Input:
+4 ; HARDSHIP - hardship array, pass by reference
+5 ;Output:
+6 ; HARDSHIP - hardship array (pass by reference)
+7 ;
+8 ;DG*5.3*996
NEW ERROR,DGSRCTST
+9 ;GET SRC OF TEST DATA DG*5.3*996
SET DGSRCTST=$$GETSRC(HARDSHIP("MTIEN"))
+10 ;IF SRC OF TEST IS DCD (3) NO EDITING ALLOWED DG*5.3*996
IF DGSRCTST=3
Begin DoDot:1
+11 ;DISPLAY MESSAGE TO NOTIFY USER DG*5.3*996
WRITE !,"PLEASE USE ES TO EDIT HARDSHIP."
DO PAUSE^VALM1
QUIT
End DoDot:1
QUIT
+12 ;IF SITE GRANTING HARDSHIP IS EMPTY THEN IT IS A MANUAL ENTRY AND DGSITE AND HARDSHIP("SITE") ARE EQUAL DG*5.3*996
IF HARDSHIP("SITE")=""
IF DUZ=HARDSHIP("BY")
SET HARDSHIP("SITE")=+$$GETSITE^DGMTU4(DUZ)
+13 ;DG*5.3*996
IF +$$GETSITE^DGMTU4(DUZ)=+HARDSHIP("SITE")
IF $DATA(^XUSEC("DG MEANSTEST",DUZ))
IF DGSRCTST'=3
Begin DoDot:1
+14 IF '$$GETSTAT(.HARDSHIP,1)
QUIT
+15 IF '$$GETEFF(.HARDSHIP)
QUIT
+16 ;I '$$GETREV(.HARDSHIP) Q ;commented out per requirement DG*5.3*996
+17 ;set review date to December 31 of current year DG*5.3*996
DO SETREV(.HARDSHIP)
+18 IF '$$GETREAS(.HARDSHIP)
QUIT
+19 DO PRIOR(.HARDSHIP)
+20 IF $$STORE^DGMTH(.HARDSHIP,.ERROR)
Begin DoDot:2
+21 NEW EVENTS
+22 SET EVENTS("IVM")=1
+23 IF $$LOG^IVMPLOG(HARDSHIP("DFN"),HARDSHIP("YEAR"),.EVENTS)
End DoDot:2
+24 IF '$TEST
WRITE !,$GET(ERROR)
DO PAUSE^VALM1
+25 DO AFTER(.HARDSHIP)
End DoDot:1
+26 DO INIT^DGMTHL
+27 SET VALMBCK="R"
+28 QUIT
+29 ;
CHKDEL(HARDSHIP) ;
+1 ;Checks whether the hardship can be deleted.
+2 ;Input:
+3 ; HARDSHIP - hardship array (pass by reference)
+4 IF (HARDSHIP("HARDSHIP?")="1")
IF (HARDSHIP("BY")!((+HARDSHIP("SITE")=+$$GETSITE^DGMTU4($GET(DUZ)))))
QUIT 1
+5 QUIT 0
DELETE(HARDSHIP) ;
+1 ;Deletes the hardship.
+2 ;
+3 ;Input:
+4 ; HARDSHIP - hardship array (pass by reference)
+5 ;
+6 ;DG*5.3*996
NEW ERROR,DGSRCTST
+7 ;GET SRC OF TEST DATA DG*5.3*996
SET DGSRCTST=$$GETSRC(HARDSHIP("MTIEN"))
+8 ;IF SRC OF TEST IS DCD (3) NO EDITING ALLOWED DG*5.3*996
IF DGSRCTST=3
Begin DoDot:1
+9 ;DISPLAY MESSAGE TO NOTIFY USER DG*5.3*996
WRITE !,"PLEASE USE ES TO EDIT HARDSHIP."
DO PAUSE^VALM1
QUIT
End DoDot:1
QUIT
+10 ;IF SITE GRANTING HARDSHIP IS EMPTY THEN IT IS A MANUAL ENTRY AND DGSITE AND HARDSHIP("SITE") ARE EQUAL DG*5.3*996
IF HARDSHIP("SITE")=""
IF DUZ=HARDSHIP("BY")
SET HARDSHIP("SITE")=+$$GETSITE^DGMTU4(DUZ)
+11 ;DG*5.3*996 ;DG*5.3*997 CANNOT DELETE EXPIRED HARDSHIP
IF +$$GETSITE^DGMTU4(DUZ)=+HARDSHIP("SITE")
IF $DATA(^XUSEC("DG MEANSTEST",DUZ))
IF DGSRCTST'=3
IF HARDSHIP("EXPIRATION")=""
Begin DoDot:1
+12 IF $$RUSURE
IF '$$DELETE^DGMTH(.HARDSHIP,1,.ERROR)
WRITE !,"AN ERROR OCCURRED - "_$GET(ERROR)
DO PAUSE^VALM1
+13 DO INIT^DGMTHL
+14 SET VALMBCK="R"
End DoDot:1
+15 QUIT
+16 ;
GETSTAT(HARDSHIP,EDITFLG) ;
+1 ;Asks the user to enter the means test status.
+2 ;
+3 ;Input:
+4 ; HARDSHIP - hardship array (pass by reference)
+5 ; EDITFLG - Edit Flag: 1=Edit
+6 ;Output:
+7 ; HARDSHIP("CURRENT STATUS")
+8 ;
+9 NEW DIR,FLTRSTAT
+10 SET FLTRSTAT=$$GETCODE^DGMTH($SELECT($GET(EDITFLG):HARDSHIP("TEST STATUS"),1:HARDSHIP("CURRENT STATUS")))
+11 SET DIR(0)="Pr^408.32:EMZ"
+12 SET DIR("S")="I $P(^(0),U,19)=1"
+13 IF "CP"[FLTRSTAT
SET DIR("S")=DIR("S")_",""AG""[$P(^(0),U,2)"
+14 IF FLTRSTAT="G"
SET DIR("S")=DIR("S")_",""A""[$P(^(0),U,2)"
+15 SET DIR("A")="Means Test Status"
+16 SET DIR("B")=$$EXT^DGMTH("CURRENT STATUS",HARDSHIP("CURRENT STATUS"))
+17 DO FULL^VALM1
+18 DO ^DIR
+19 IF $DATA(DIRUT)
QUIT 0
+20 IF Y<1
QUIT 0
+21 SET HARDSHIP("CURRENT STATUS")=+Y
+22 ; Don't reset agreed to pay if mt copay req/GMT copay req/pend adj
+23 if "^C^G^P^"'[(U_$PIECE($GET(^DG(408.32,+Y,0)),U,2)_U)
SET HARDSHIP("AGREE")=""
+24 SET VALMBCK="R"
+25 QUIT 1
+26 ;
GETEFF(HARDSHIP) ;
+1 ;Asks the user to enter the effective date. Returns 1 on success, 0 on failure
+2 ;
+3 ;Input:
+4 ; HARDSHIP - hardship array (pass by reference)
+5 ;Output:
+6 ; HARDSHIP("EFFECTIVE")
+7 ;
+8 NEW DIR
+9 SET DIR(0)="D^"_HARDSHIP("TEST DATE")_":"_DT_":EX"
+10 SET DIR("A")="Hardship Effective Date"
+11 SET DIR("B")=$$FMTE^XLFDT($SELECT(HARDSHIP("EFFECTIVE"):HARDSHIP("EFFECTIVE"),1:HARDSHIP("TEST DATE")),"1D")
+12 DO ^DIR
+13 IF $DATA(DIRUT)
QUIT 0
+14 IF Y<1
QUIT 0
+15 SET HARDSHIP("EFFECTIVE")=Y
+16 QUIT 1
GETREV(HARDSHIP) ;
+1 ;Asks the user to enter the review date. Returns 1 on success, 0 on failure
+2 ;
+3 ;Input:
+4 ; HARDSHIP - hardship array (pass by reference)
+5 ;Output:
+6 ; HARDSHIP("REVIEW")
+7 ;
+8 NEW RET,STOP,X,Y
+9 SET (STOP,RET)=0
+10 SET DIR(0)="DO^::EX"
+11 SET DIR("A")="Hardship Review Date"
+12 IF HARDSHIP("REVIEW")
SET DIR("B")=$$FMTE^XLFDT(HARDSHIP("REVIEW"),"1D")
+13 SET DIR("?")="Enter a future date if you wish to conduct a review."
+14 FOR
Begin DoDot:1
+15 NEW DIR
+16 SET DIR(0)="DO^::EX"
+17 SET DIR("A")="Hardship Review Date"
+18 IF HARDSHIP("REVIEW")
SET DIR("B")=$$FMTE^XLFDT(HARDSHIP("REVIEW"),"1D")
+19 SET DIR("?")="Enter a future date if you wish to conduct a review."
+20 DO ^DIR
+21 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
SET STOP=1
SET RET=0
QUIT
+22 IF X="@"
SET Y=""
SET STOP=1
SET RET=1
QUIT
+23 IF Y=-1
SET STOP=1
SET RET=0
QUIT
+24 IF Y<DT
WRITE !,DIR("?")
QUIT
+25 SET (STOP,RET)=1
End DoDot:1
if STOP
QUIT
+26 if RET
SET HARDSHIP("REVIEW")=Y
+27 QUIT RET
+28 ;
GETREAS(HARDSHIP) ;
+1 ;Asks the user to enter the hardship reason.
+2 ;
+3 ;Input:
+4 ; HARDSHIP - hardship array (pass by reference)
+5 ;Output
+6 ; HARDSHIP("REASON")
+7 ;
+8 NEW DIR
+9 SET DIR(0)="FO^3:80"
+10 SET DIR("A")="Hardship Reason"
+11 SET DIR("B")=$GET(HARDSHIP("REASON"))
if DIR("B")=""
KILL DIR("B")
+12 DO ^DIR
+13 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT 0
+14 SET HARDSHIP("REASON")=Y
+15 QUIT 1
+16 ;
PRIOR(HARDSHIP) ;set up for means test event driver
+1 SET DFN=HARDSHIP("DFN")
+2 SET DGMTI=HARDSHIP("MTIEN")
+3 SET DGMTS=HARDSHIP("CURRENT STATUS")
+4 SET DGMTACT="CAT"
+5 SET DGMTYPT=1
+6 DO PRIOR^DGMTEVT
+7 QUIT
AFTER(HARDSHIP) ;calls means test event driver
+1 DO AFTER^DGMTEVT
+2 SET DGMTINF=0
+3 DO EN^DGMTEVT
+4 KILL DGMTA,DGMTACT,DGMTDT,DGMTI,DGMTINF,DGMTP,DGMTS,DGMTYPT,I,J,Y
+5 QUIT
+1 ;Edit Comments protocol.
+2 ;
+3 ;Input:
+4 ; HARDSHIP - hardship array, pass by reference
+5 ;Output:
+6 ; none
+7 ;
+8 NEW DA,DIE,DR
+9 IF $GET(DUZ)'>1
WRITE !,"YOUR DUZ IS NOT DEFINED!"
DO PAUSE^VALM1
SET VALMBCK="R"
QUIT
+10 DO FULL^VALM1
+11 IF $GET(HARDSHIP("MTIEN"))
SET DR="50"
SET DA=HARDSHIP("MTIEN")
SET DIE=408.31
DO ^DIE
+12 DO INIT^DGMTHL
+13 IF VALMCNT<15
SET VALMBG=1
+14 SET VALMBCK="R"
+15 QUIT
+16 ;
RUSURE() ;
+1 ;Description: Asks user 'Are you sure?'
+2 ;Input: none
+3 ;Output: Function Value returns 0 or 1
+4 ;
+5 NEW DIR
+6 SET DIR(0)="Y"
+7 SET DIR("A")="Are you sure that the hardship should be deleted"
+8 SET DIR("B")="NO"
+9 DO ^DIR
+10 if $DATA(DIRUT)
QUIT 0
+11 QUIT Y
EXSURE() ;
+1 ;Description: Asks user 'Are you sure?'
+2 ;Input: none
+3 ;Output: Function Value returns 0 or 1
+4 ;
+5 NEW DIR
+6 SET DIR(0)="Y"
+7 SET DIR("A")="Are you sure you want to Expire this Hardship? (enter yes or no) "
+8 SET DIR("B")="NO"
+9 DO ^DIR
+10 if $DATA(DIRUT)
QUIT 0
+11 QUIT Y
SETREV(HARDSHIP) ;SET REVIEW DATE TO DEC 31 OF CURRENT YEAR SO THAT HARDSHIP WILL EXPIRE DECEMBER 31 11:59 PM OF CURRENT YEAR
+1 ;DG*5.3*996
+2 ;DG*5.3*997
NEW REVDT,REVDTYR,REVDTDIF
+3 ;DG*5.3*997 SET REVIEW DATE TO 60 DAY PRIOR
SET REVDT=$EXTRACT(DT,1,3)
SET REVDT=REVDT_"1101"
SET HARDSHIP("REVIEW")=REVDT
+4 ;DG*5.3*997 SET EXPIRATION DATE TO THE SAME
SET REVDT=$EXTRACT(DT,1,3)
SET REVDT=REVDT_"1231"
SET HARDSHIP("EXPIRATION")=REVDT
+5 ;IF HARDSHIP EXPIRATION DATE IS LESS THAN 60 DAYS TO TODAY SET HARDSHIP("REVIEW") DATE TO TODAY DG*5.3*997
+6 ;DG*5.3*997
SET REVDTDIF=($$FMTH^XLFDT(HARDSHIP("EXPIRATION")))-($$FMTH^XLFDT(DT))
IF REVDTDIF<60
SET HARDSHIP("REVIEW")=DT
+7 QUIT
+8 ;
SETREVEX(HARDSHIP) ;SET REVIEW DATE TO HARDSHIP EXPIRATION DATE ENTERED IN
+1 ;DG*5.3*997
+2 NEW REVDT,REVDTYR
+3 SET REVDT=HARDSHIP("EXPIRATION")
+4 QUIT
+5 ;
GETSRC(MTIEN) ; GET SOURCE OF TEST DATA TO DETERMINE IF FROM DCD ;DG*5.3*996
+1 NEW RET,NODE0
+2 SET NODE0=$GET(^DGMT(408.31,MTIEN,0))
+3 SET RET=$PIECE(NODE0,"^",23)
+4 QUIT RET
+5 ;
HRDSHPR ; RESPONSE FOR HARDSHIP EDIT OR DELETE
+1 NEW MSG
+2 SET MSG="PLEASE USE ES TO EDIT HARDSHIP"
+3 QUIT MSG
