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

DGMTHL1.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. EN(DGARY,HARDSHIP,DGCNT) ;Entry point to build list area
  1. ; Input;
  1. ; DGARY Global array subscript
  1. ; HARDSHIP - hardship array (pass by reference)
  1. ; Output -- DGCNT Number of lines in the list
  1. ;
  1. N DGLINE
  1. S DGLINE=1,DGCNT=0
  1. D SET(DGARY,.HARDSHIP,.DGLINE,.DGCNT)
  1. Q
  1. ;
  1. SET(DGARY,HARDSHIP,DGLINE,DGCNT) ;
  1. ;Description: Writes hardship
  1. ; Input -- DGARY Global array subscript
  1. ; HARDSHIP Hardship array
  1. ; DGLINE Line number
  1. ; Output -- DGCNT Number of lines in the list
  1. N DGSTART,LINE
  1. ;
  1. S DGSTART=DGLINE ; starting line number
  1. D SET^DGENL1(DGARY,DGLINE,"Hardship",21,IORVON,IORVOFF,,,,.DGCNT)
  1. S DGLINE=DGLINE+1
  1. D SET^DGENL1(DGARY,DGLINE,$J("Current Means Test Status: ",31)_$$EXT^DGMTH("CURRENT STATUS",HARDSHIP("CURRENT STATUS")),1,,,,,,.DGCNT)
  1. S DGLINE=DGLINE+1
  1. D SET^DGENL1(DGARY,DGLINE,$J("Income Year: ",31)_$S(HARDSHIP("YEAR"):$$EXT^DGMTH("YEAR",HARDSHIP("YEAR")),1:""),1,,,,,,.DGCNT)
  1. S DGLINE=DGLINE+1
  1. D SET^DGENL1(DGARY,DGLINE,$J("Means Test Date: ",31)_$$EXT^DGMTH("TEST DATE",HARDSHIP("TEST DATE")),1,,,,,,.DGCNT)
  1. S DGLINE=DGLINE+1
  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
  1. ;
  1. S DGLINE=DGLINE+1
  1. I HARDSHIP("EXPIRATION")'="",HARDSHIP("EFFECTIVE")<=HARDSHIP("EXPIRATION"),HARDSHIP("EXPIRATION")<=DT D ;DG*5.3*997
  1. .D SET^DGENL1(DGARY,DGLINE,$J("Hardship?: ",31)_"EXPIRED",1,,,,,,.DGCNT) ;DG*5.3*997
  1. E D SET^DGENL1(DGARY,DGLINE,$J("Hardship?: ",31)_$$EXT^DGMTH("HARDSHIP?",HARDSHIP("HARDSHIP?")),1,,,,,,.DGCNT) ;DG*5.3*997
  1. S DGLINE=DGLINE+1
  1. D SET^DGENL1(DGARY,DGLINE,$J("Hardship Effective Date: ",31)_$$EXT^DGMTH("EFFECTIVE",HARDSHIP("EFFECTIVE")),1,,,,,,.DGCNT)
  1. S DGLINE=DGLINE+1
  1. D SET^DGENL1(DGARY,DGLINE,$J("Review Date: ",31)_$$EXT^DGMTH("REVIEW",HARDSHIP("REVIEW")),1,,,,,,.DGCNT)
  1. S DGLINE=DGLINE+1
  1. D SET^DGENL1(DGARY,DGLINE,$J("Hardship Expiration Date: ",31)_$$EXT^DGMTH("EXPIRATION",HARDSHIP("EXPIRATION")),1,,,,,,.DGCNT) ;DG*5.3*997
  1. S DGLINE=DGLINE+1
  1. D SET^DGENL1(DGARY,DGLINE,$J("Site Granting Hardship: ",31)_$$EXT^DGMTH("SITE",HARDSHIP("SITE")),1,,,,,,.DGCNT)
  1. S DGLINE=DGLINE+1 ;DG*5.3*997
  1. D SET^DGENL1(DGARY,DGLINE,$J("Approved By: ",31)_$$EXT^DGMTH("BY",HARDSHIP("BY")),1,,,,,,.DGCNT)
  1. S DGLINE=DGLINE+1
  1. D SET^DGENL1(DGARY,DGLINE,$J("Hardship Reason: ",31)_$$EXT^DGMTH("REASON",HARDSHIP("REASON")),1,,,,,,.DGCNT)
  1. S DGLINE=DGLINE+2
  1. ;
  1. D SET^DGENL1(DGARY,DGLINE,$J("Date Category Last Changed: ",31)_$$EXT^DGMTH("DT/TM CTGRY CHNGD",HARDSHIP("DT/TM CTGRY CHNGD")),1,,,,,,.DGCNT)
  1. S DGLINE=DGLINE+1
  1. D SET^DGENL1(DGARY,DGLINE,$J("Category Last Changed By: ",31)_$$EXT^DGMTH("CTGRY CHNGD BY",HARDSHIP("CTGRY CHNGD BY")),1,,,,,,.DGCNT)
  1. S DGLINE=DGLINE+1
  1. I $D(^DGMT(408.31,HARDSHIP("MTIEN"),"C")) D
  1. .N LINE
  1. .D SET^DGENL1(DGARY,DGLINE,"COMMENTS:",1,$G(IOINHI),$G(IOINORM),,,,.DGCNT)
  1. .S DGLINE=DGLINE+1
  1. .S LINE=0
  1. .F S LINE=$O(^DGMT(408.31,HARDSHIP("MTIEN"),"C",LINE)) Q:'LINE D
  1. ..D SET^DGENL1(DGARY,DGLINE,$G(^DGMT(408.31,HARDSHIP("MTIEN"),"C",LINE,0)),1,,,,,,.DGCNT)
  1. ..S DGLINE=DGLINE+1
  1. Q
  1. ;
  1. CHKADD(HARDSHIP) ;
  1. ;Determines whether granting a hardship is appropriate
  1. ;Input:
  1. ; HARDSHIP - hardship array (pass by reference)
  1. ;Output:
  1. ; Function Value - 1 if the hardship can be granted, 0 otherwise
  1. ;
  1. ; Add check for MT more than a year old (DG*5.3*858)
  1. I $G(HARDSHIP("TEST DATE")),$$OLD^DGMTU4(HARDSHIP("TEST DATE")) Q 0
  1. ;
  1. N CODE
  1. S CODE=""
  1. S CODE=$$GETCODE^DGMTH(HARDSHIP("CURRENT STATUS"))
  1. I CODE'="C",CODE'="G" Q 0 ;Remove pending adjudication DG*5.3*997
  1. 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
  1. Q 1
  1. ;
  1. ADD(HARDSHIP) ;
  1. ;Add hardship protocol.
  1. ;
  1. ;Input:
  1. ; HARDSHIP - hardship array, pass by reference
  1. ;Output:
  1. ; HARDSHIP - hardship array (pass by reference)
  1. ;
  1. N CODE,ERROR
  1. I $G(DUZ)'>1 W !,"YOUR DUZ IS NOT DEFINED!" D PAUSE^VALM1 S VALMBCK="R" Q
  1. S CODE=""
  1. S CODE=$$GETCODE^DGMTH(HARDSHIP("CURRENT STATUS"))
  1. I CODE'="C",CODE'="P",CODE'="G" W !,"PATIENT NOT CURRENTLY RESPONSIBLE FOR COPAYMENT CHARGES!" D PAUSE^VALM1 Q
  1. S HARDSHIP("EFFECTIVE")=DT
  1. S HARDSHIP("SITE")=$$GETSITE^DGMTU4(.DUZ)
  1. I HARDSHIP("TEST STATUS")="" S HARDSHIP("TEST STATUS")=HARDSHIP("CURRENT STATUS")
  1. ;S HARDSHIP("CURRENT STATUS")=$$GETSTAT^DGMTH("A",1)
  1. S HARDSHIP("BY")=DUZ
  1. S HARDSHIP("CTGRY CHNGD BY")=DUZ
  1. S HARDSHIP("DT/TM CTGRY CHNGD")=$$NOW^XLFDT
  1. S HARDSHIP("HARDSHIP?")=1
  1. D
  1. .I HARDSHIP("EXPIRATION") Q ;DG*5.3*997 CANNOT ADD WHEN EXPIRED HARDSHIP
  1. .I '$$GETSTAT(.HARDSHIP) Q
  1. .I '$$GETEFF(.HARDSHIP) Q
  1. .;I '$$GETREV(.HARDSHIP) Q ;commented out per requirement DG*5.3*996
  1. .D SETREV(.HARDSHIP) ;set review date to December 31 of current year DG*5.3*996
  1. .I '$$GETREAS(.HARDSHIP) Q
  1. .D PRIOR(.HARDSHIP)
  1. .I $$STORE^DGMTH(.HARDSHIP,.ERROR) D
  1. ..N EVENTS
  1. ..S EVENTS("IVM")=1
  1. ..I $$LOG^IVMPLOG(HARDSHIP("DFN"),HARDSHIP("YEAR"),.EVENTS)
  1. .E W !,$G(ERROR) D PAUSE^VALM1
  1. .D AFTER(.HARDSHIP)
  1. D INIT^DGMTHL
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. EDIT(HARDSHIP) ;
  1. ;Add hardship protocol.
  1. ;
  1. ;Input:
  1. ; HARDSHIP - hardship array, pass by reference
  1. ;Output:
  1. ; HARDSHIP - hardship array (pass by reference)
  1. ;
  1. N ERROR,DGSRCTST ;DG*5.3*996
  1. S DGSRCTST=$$GETSRC(HARDSHIP("MTIEN")) ;GET SRC OF TEST DATA DG*5.3*996
  1. I DGSRCTST=3 D Q ;IF SRC OF TEST IS DCD (3) NO EDITING ALLOWED DG*5.3*996
  1. .W !,"PLEASE USE ES TO EDIT HARDSHIP." D PAUSE^VALM1 Q ;DISPLAY MESSAGE TO NOTIFY USER DG*5.3*996
  1. 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
  1. I +$$GETSITE^DGMTU4(DUZ)=+HARDSHIP("SITE"),$D(^XUSEC("DG MEANSTEST",DUZ)),DGSRCTST'=3 D ;DG*5.3*996
  1. .I '$$GETSTAT(.HARDSHIP,1) Q
  1. .I '$$GETEFF(.HARDSHIP) Q
  1. .;I '$$GETREV(.HARDSHIP) Q ;commented out per requirement DG*5.3*996
  1. .D SETREV(.HARDSHIP) ;set review date to December 31 of current year DG*5.3*996
  1. .I '$$GETREAS(.HARDSHIP) Q
  1. .D PRIOR(.HARDSHIP)
  1. .I $$STORE^DGMTH(.HARDSHIP,.ERROR) D
  1. ..N EVENTS
  1. ..S EVENTS("IVM")=1
  1. ..I $$LOG^IVMPLOG(HARDSHIP("DFN"),HARDSHIP("YEAR"),.EVENTS)
  1. .E W !,$G(ERROR) D PAUSE^VALM1
  1. .D AFTER(.HARDSHIP)
  1. D INIT^DGMTHL
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. CHKDEL(HARDSHIP) ;
  1. ;Checks whether the hardship can be deleted.
  1. ;Input:
  1. ; HARDSHIP - hardship array (pass by reference)
  1. I (HARDSHIP("HARDSHIP?")="1"),(HARDSHIP("BY")!((+HARDSHIP("SITE")=+$$GETSITE^DGMTU4($G(DUZ))))) Q 1
  1. Q 0
  1. DELETE(HARDSHIP) ;
  1. ;Deletes the hardship.
  1. ;
  1. ;Input:
  1. ; HARDSHIP - hardship array (pass by reference)
  1. ;
  1. N ERROR,DGSRCTST ;DG*5.3*996
  1. S DGSRCTST=$$GETSRC(HARDSHIP("MTIEN")) ;GET SRC OF TEST DATA DG*5.3*996
  1. I DGSRCTST=3 D Q ;IF SRC OF TEST IS DCD (3) NO EDITING ALLOWED DG*5.3*996
  1. .W !,"PLEASE USE ES TO EDIT HARDSHIP." D PAUSE^VALM1 Q ;DISPLAY MESSAGE TO NOTIFY USER DG*5.3*996
  1. 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
  1. 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
  1. .I $$RUSURE,'$$DELETE^DGMTH(.HARDSHIP,1,.ERROR) W !,"AN ERROR OCCURRED - "_$G(ERROR) D PAUSE^VALM1
  1. .D INIT^DGMTHL
  1. .S VALMBCK="R"
  1. Q
  1. ;
  1. GETSTAT(HARDSHIP,EDITFLG) ;
  1. ;Asks the user to enter the means test status.
  1. ;
  1. ;Input:
  1. ; HARDSHIP - hardship array (pass by reference)
  1. ; EDITFLG - Edit Flag: 1=Edit
  1. ;Output:
  1. ; HARDSHIP("CURRENT STATUS")
  1. ;
  1. N DIR,FLTRSTAT
  1. S FLTRSTAT=$$GETCODE^DGMTH($S($G(EDITFLG):HARDSHIP("TEST STATUS"),1:HARDSHIP("CURRENT STATUS")))
  1. S DIR(0)="Pr^408.32:EMZ"
  1. S DIR("S")="I $P(^(0),U,19)=1"
  1. I "CP"[FLTRSTAT S DIR("S")=DIR("S")_",""AG""[$P(^(0),U,2)"
  1. I FLTRSTAT="G" S DIR("S")=DIR("S")_",""A""[$P(^(0),U,2)"
  1. S DIR("A")="Means Test Status"
  1. S DIR("B")=$$EXT^DGMTH("CURRENT STATUS",HARDSHIP("CURRENT STATUS"))
  1. D FULL^VALM1
  1. D ^DIR
  1. I $D(DIRUT) Q 0
  1. I Y<1 Q 0
  1. S HARDSHIP("CURRENT STATUS")=+Y
  1. ; Don't reset agreed to pay if mt copay req/GMT copay req/pend adj
  1. S:"^C^G^P^"'[(U_$P($G(^DG(408.32,+Y,0)),U,2)_U) HARDSHIP("AGREE")=""
  1. S VALMBCK="R"
  1. Q 1
  1. ;
  1. GETEFF(HARDSHIP) ;
  1. ;Asks the user to enter the effective date. Returns 1 on success, 0 on failure
  1. ;
  1. ;Input:
  1. ; HARDSHIP - hardship array (pass by reference)
  1. ;Output:
  1. ; HARDSHIP("EFFECTIVE")
  1. ;
  1. N DIR
  1. S DIR(0)="D^"_HARDSHIP("TEST DATE")_":"_DT_":EX"
  1. S DIR("A")="Hardship Effective Date"
  1. S DIR("B")=$$FMTE^XLFDT($S(HARDSHIP("EFFECTIVE"):HARDSHIP("EFFECTIVE"),1:HARDSHIP("TEST DATE")),"1D")
  1. D ^DIR
  1. I $D(DIRUT) Q 0
  1. I Y<1 Q 0
  1. S HARDSHIP("EFFECTIVE")=Y
  1. Q 1
  1. GETREV(HARDSHIP) ;
  1. ;Asks the user to enter the review date. Returns 1 on success, 0 on failure
  1. ;
  1. ;Input:
  1. ; HARDSHIP - hardship array (pass by reference)
  1. ;Output:
  1. ; HARDSHIP("REVIEW")
  1. ;
  1. N RET,STOP,X,Y
  1. S (STOP,RET)=0
  1. S DIR(0)="DO^::EX"
  1. S DIR("A")="Hardship Review Date"
  1. I HARDSHIP("REVIEW") S DIR("B")=$$FMTE^XLFDT(HARDSHIP("REVIEW"),"1D")
  1. S DIR("?")="Enter a future date if you wish to conduct a review."
  1. F D Q:STOP
  1. .N DIR
  1. .S DIR(0)="DO^::EX"
  1. .S DIR("A")="Hardship Review Date"
  1. .I HARDSHIP("REVIEW") S DIR("B")=$$FMTE^XLFDT(HARDSHIP("REVIEW"),"1D")
  1. .S DIR("?")="Enter a future date if you wish to conduct a review."
  1. .D ^DIR
  1. .I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) S STOP=1,RET=0 Q
  1. .I X="@" S Y="",STOP=1,RET=1 Q
  1. .I Y=-1 S STOP=1,RET=0 Q
  1. .I Y<DT W !,DIR("?") Q
  1. .S (STOP,RET)=1
  1. S:RET HARDSHIP("REVIEW")=Y
  1. Q RET
  1. ;
  1. GETREAS(HARDSHIP) ;
  1. ;Asks the user to enter the hardship reason.
  1. ;
  1. ;Input:
  1. ; HARDSHIP - hardship array (pass by reference)
  1. ;Output
  1. ; HARDSHIP("REASON")
  1. ;
  1. N DIR
  1. S DIR(0)="FO^3:80"
  1. S DIR("A")="Hardship Reason"
  1. S DIR("B")=$G(HARDSHIP("REASON")) K:DIR("B")="" DIR("B")
  1. D ^DIR
  1. I $D(DTOUT)!$D(DUOUT) Q 0
  1. S HARDSHIP("REASON")=Y
  1. Q 1
  1. ;
  1. PRIOR(HARDSHIP) ;set up for means test event driver
  1. S DFN=HARDSHIP("DFN")
  1. S DGMTI=HARDSHIP("MTIEN")
  1. S DGMTS=HARDSHIP("CURRENT STATUS")
  1. S DGMTACT="CAT"
  1. S DGMTYPT=1
  1. D PRIOR^DGMTEVT
  1. Q
  1. AFTER(HARDSHIP) ;calls means test event driver
  1. D AFTER^DGMTEVT
  1. S DGMTINF=0
  1. D EN^DGMTEVT
  1. K DGMTA,DGMTACT,DGMTDT,DGMTI,DGMTINF,DGMTP,DGMTS,DGMTYPT,I,J,Y
  1. Q
  1. COMMENTS(HARDSHIP) ;
  1. ;Edit Comments protocol.
  1. ;
  1. ;Input:
  1. ; HARDSHIP - hardship array, pass by reference
  1. ;Output:
  1. ; none
  1. ;
  1. N DA,DIE,DR
  1. I $G(DUZ)'>1 W !,"YOUR DUZ IS NOT DEFINED!" D PAUSE^VALM1 S VALMBCK="R" Q
  1. D FULL^VALM1
  1. I $G(HARDSHIP("MTIEN")) S DR="50",DA=HARDSHIP("MTIEN"),DIE=408.31 D ^DIE
  1. D INIT^DGMTHL
  1. I VALMCNT<15 S VALMBG=1
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. RUSURE() ;
  1. ;Description: Asks user 'Are you sure?'
  1. ;Input: none
  1. ;Output: Function Value returns 0 or 1
  1. ;
  1. N DIR
  1. S DIR(0)="Y"
  1. S DIR("A")="Are you sure that the hardship should be deleted"
  1. S DIR("B")="NO"
  1. D ^DIR
  1. Q:$D(DIRUT) 0
  1. Q Y
  1. EXSURE() ;
  1. ;Description: Asks user 'Are you sure?'
  1. ;Input: none
  1. ;Output: Function Value returns 0 or 1
  1. ;
  1. N DIR
  1. S DIR(0)="Y"
  1. S DIR("A")="Are you sure you want to Expire this Hardship? (enter yes or no) "
  1. S DIR("B")="NO"
  1. D ^DIR
  1. Q:$D(DIRUT) 0
  1. Q Y
  1. 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
  1. N REVDT,REVDTYR,REVDTDIF ;DG*5.3*997
  1. S REVDT=$E(DT,1,3),REVDT=REVDT_"1101",HARDSHIP("REVIEW")=REVDT ;DG*5.3*997 SET REVIEW DATE TO 60 DAY PRIOR
  1. S REVDT=$E(DT,1,3),REVDT=REVDT_"1231",HARDSHIP("EXPIRATION")=REVDT ;DG*5.3*997 SET EXPIRATION DATE TO THE SAME
  1. ;IF HARDSHIP EXPIRATION DATE IS LESS THAN 60 DAYS TO TODAY SET HARDSHIP("REVIEW") DATE TO TODAY DG*5.3*997
  1. S REVDTDIF=($$FMTH^XLFDT(HARDSHIP("EXPIRATION")))-($$FMTH^XLFDT(DT)) I REVDTDIF<60 S HARDSHIP("REVIEW")=DT ;DG*5.3*997
  1. Q
  1. ;
  1. SETREVEX(HARDSHIP) ;SET REVIEW DATE TO HARDSHIP EXPIRATION DATE ENTERED IN
  1. ;DG*5.3*997
  1. N REVDT,REVDTYR
  1. S REVDT=HARDSHIP("EXPIRATION")
  1. Q
  1. ;
  1. GETSRC(MTIEN) ; GET SOURCE OF TEST DATA TO DETERMINE IF FROM DCD ;DG*5.3*996
  1. N RET,NODE0
  1. S NODE0=$G(^DGMT(408.31,MTIEN,0))
  1. S RET=$P(NODE0,"^",23)
  1. Q RET
  1. ;
  1. HRDSHPR ; RESPONSE FOR HARDSHIP EDIT OR DELETE
  1. N MSG
  1. S MSG="PLEASE USE ES TO EDIT HARDSHIP"
  1. Q MSG