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

DGMTH.m

Go to the documentation of this file.
  1. DGMTH ;ALB/CJM/TDM/HM MEANS TEST HARDSHIP ; 4/7/20 3:18pm
  1. ;;5.3;Registration;**182,456,997**;Aug 13, 1993;Build 42
  1. ;
  1. FIND(DFN,DATE,STATUS) ;
  1. ;Finds the primary means test for the specified patient and date.
  1. ;
  1. ;Input:
  1. ; DFN
  1. ; DATE - date to look for the MT, DT assumed if not passed (optional)
  1. ;Output:
  1. ; Function Value - 0 if no MT found, the ien otherwise
  1. ; STATUS - the status code of the MT (optional, pass by reference)
  1. ;
  1. N NODE
  1. ;
  1. S NODE=$$LST^DGMTU(DFN,$G(DATE),1)
  1. S STATUS=$P(NODE,"^",4)
  1. Q +NODE
  1. ;
  1. GET(MTIEN,HARDSHIP) ;
  1. ;Given the ien of a MT (MTIEN), returns the hardship information
  1. ;
  1. ;Output:
  1. ; Function Value - returns 0 if there is no hardship determination, 1 otherwise
  1. ; HARDSHIP(
  1. ; "HARDSHIP?") - 0 or 1, corresponding to the HARDSHIP? field
  1. ; "EFFECTIVE") - the effective date of the hardship
  1. ; "SITE") - the stations number of the site that granted the hardship
  1. ; "BY") - the DUZ of the person that entered the hardship
  1. ; "REVIEW") - the review date
  1. ; "CURRENT STATUS") - patient's current MT status
  1. ; "DFN") - patient's DFN
  1. ; "TEST DATE") - DATE OF TEST
  1. ; "CTGRY CHNGD BY") - DUZ of person who last changed the category
  1. ; "DT/TM CTGRY CHNGD") -
  1. ; "AGREE") - AGREED TO PAY DEDUCTIBLE
  1. ; "MTIEN") - IEN of the means test
  1. ; "TEST STATUS") - TEST DETERMINED STATUS
  1. ; "REASON") - Hardship Reason
  1. ;
  1. N NODE0,NODE2
  1. S (NODE0,NODE2)=""
  1. I MTIEN D
  1. .S NODE0=$G(^DGMT(408.31,MTIEN,0))
  1. .S NODE2=$G(^DGMT(408.31,MTIEN,2))
  1. S HARDSHIP("MTIEN")=MTIEN
  1. S HARDSHIP("TEST DATE")=$P(NODE0,"^")
  1. S HARDSHIP("CURRENT STATUS")=$P(NODE0,"^",3)
  1. S HARDSHIP("CTGRY CHNGD BY")=$P(NODE0,"^",8)
  1. S HARDSHIP("DT/TM CTGRY CHNGD")=$P(NODE0,"^",9)
  1. S HARDSHIP("AGREE")=$P(NODE0,"^",11)
  1. S HARDSHIP("TEST STATUS")=$P(NODE2,"^",3)
  1. S HARDSHIP("DFN")=$P(NODE0,"^",2)
  1. S HARDSHIP("EFFECTIVE")=$P(NODE2,"^")
  1. S HARDSHIP("SITE")=$P(NODE2,"^",4)
  1. S HARDSHIP("BY")=$P(NODE0,"^",22)
  1. S HARDSHIP("HARDSHIP?")=$P(NODE0,"^",20)
  1. S HARDSHIP("REVIEW")=$P(NODE0,"^",21)
  1. S HARDSHIP("YEAR")=$S(+NODE0:($E(NODE0,1,3)-1),1:"")
  1. S HARDSHIP("REASON")=$P(NODE2,"^",9)
  1. S HARDSHIP("EXPIRATION")=$P(NODE2,"^",13) ;DG*5.3*997
  1. S HARDSHIP("EXPIRED")=$P(NODE2,"^",12) ;DG*5.3*997
  1. Q +HARDSHIP("HARDSHIP?")
  1. ;
  1. FIELD(SUB) ;
  1. ;Given the subscript used, returns the field number
  1. I SUB="EFFECTIVE" Q 2.01
  1. I SUB="SITE" Q 2.04
  1. I SUB="BY" Q .22
  1. I SUB="REASON" Q 2.09
  1. I SUB="EXPIRATION" Q 2.13 ;DG*5.3*997
  1. I SUB="EXPIRED" Q 2.12 ;DG*5.3*997
  1. Q $S(SUB="HARDSHIP?":.2,SUB="REVIEW":.21,SUB="DFN":.02,SUB="CURRENT STATUS":.03,SUB="TEST STATUS":2.03,SUB="TEST DATE":.01,SUB="CTGRY CHNGD BY":.08,SUB="DT/TM CTGRY CHNGD":.09,SUB="AGREE":.11,1:"")
  1. ;
  1. EXT(SUB,VAL) ;
  1. ;Returns the external value of a field, given the subscript and the internal value
  1. ;
  1. Q:$$FIELD(SUB) $$EXTERNAL^DILFD(408.31,$$FIELD(SUB),"F",VAL)
  1. Q:((SUB="YEAR")&(VAL)) (+VAL)+1700
  1. Q ""
  1. ;
  1. STORE(HARDSHIP,ERROR) ;
  1. ;Stores the hardship
  1. ;
  1. ;Input:
  1. ; HARDSHIP - array containing hardship determination
  1. ;Output:
  1. ; Function Value - 0 on failure, 1 on success
  1. ; ERROR -an error message upon failure (optional,pass by reference)
  1. ;
  1. N DATA,SUB
  1. S SUB=""
  1. F SUB="EFFECTIVE","SITE","BY","HARDSHIP?","REVIEW","CURRENT STATUS","CTGRY CHNGD BY","DT/TM CTGRY CHNGD","AGREE","REASON","EXPIRATION","EXPIRED" S DATA($$FIELD(SUB))=$G(HARDSHIP(SUB)) ;DG*5.3*997
  1. Q $$UPD^DGENDBS(408.31,HARDSHIP("MTIEN"),.DATA,.ERROR)
  1. ;
  1. DELETE(HARDSHIP,NOTIFY,ERROR) ;
  1. ;Deletes the hardship, then calls MT Event Driver
  1. ;Input:
  1. ; HARDSHIP - hardship array, pass by reference
  1. ; NOTIFY - if NOTIFY=1, means to notify HEC of deletion
  1. ;Output:
  1. ; Function Value - 1 on success, 0 on failure
  1. ; ERROR - error message (pass by reference)
  1. ;
  1. N SUB,CURSTAT,TESTSTAT,SUCCESS
  1. S SUCCESS=0
  1. D PRIOR^DGMTHL1(.HARDSHIP)
  1. S CURSTAT=$$GETCODE(HARDSHIP("CURRENT STATUS"))
  1. S TESTSTAT=$$GETCODE(HARDSHIP("TEST STATUS"))
  1. S SUB=""
  1. F SUB="EFFECTIVE","SITE","BY","REVIEW","REASON" S HARDSHIP(SUB)=""
  1. S HARDSHIP("HARDSHIP?")=0
  1. I (CURSTAT="A")!(CURSTAT="G") D
  1. .I (TESTSTAT="")!(TESTSTAT="C")!(TESTSTAT="P")!(TESTSTAT="G") D
  1. ..I (TESTSTAT'="") S HARDSHIP("CURRENT STATUS")=HARDSHIP("TEST STATUS") Q
  1. ..N NODE0
  1. ..S NODE0=$G(^DGMT(408.31,HARDSHIP("MTIEN"),0))
  1. ..I CURSTAT="A",(($P(NODE0,U,4)-$P(NODE0,U,15))'>$P(NODE0,U,27)) S HARDSHIP("CURRENT STATUS")=$$GETSTAT("G",1) Q ;Income <= GMT Threshold
  1. ..S HARDSHIP("CURRENT STATUS")=$$GETSTAT("C",1)
  1. .S HARDSHIP("AGREE")=1
  1. .S HARDSHIP("CTGRY CHNGD BY")=$G(DUZ)
  1. .S HARDSHIP("DT/TM CTGRY CHNGD")=$$NOW^XLFDT
  1. I $$STORE(.HARDSHIP,.ERROR) S SUCCESS=1 D AFTER^DGMTHL1(.HARDSHIP) I ($G(NOTIFY)=1) D DELETE^IVMPLOG(HARDSHIP("DFN"),HARDSHIP("TEST DATE"),,,1)
  1. Q SUCCESS
  1. ;
  1. GETCODE(STATUS) ;
  1. ;Gets the means test status code given the ien
  1. Q:'$G(STATUS) ""
  1. Q $P($G(^DG(408.32,STATUS,0)),"^",2)
  1. ;
  1. GETNAME(STATUS) ;
  1. ;Gets the means test status name given the ien
  1. Q:'$G(STATUS) ""
  1. Q $P($G(^DG(408.32,STATUS,0)),"^")
  1. ;
  1. GETSTAT(CODE,TYPE) ;
  1. ;Given the code and type of test, returns the ien of the status as the function value
  1. ;
  1. Q:(CODE="") ""
  1. ;
  1. N STATUS,NODE
  1. S STATUS=0
  1. F S STATUS=$O(^DG(408.32,STATUS)) Q:'STATUS S NODE=$G(^DG(408.32,STATUS,0)) I $P(NODE,"^",2)=CODE,$P(NODE,"^",19)=TYPE Q
  1. Q $S(STATUS:STATUS,1:"")