- 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 Jan 18, 2025@03:45:38 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