DGMTH ;ALB/CJM/TDM/HM MEANS TEST HARDSHIP ; 4/7/20 3:18pm
;;5.3;Registration;**182,456,997**;Aug 13, 1993;Build 42
;
FIND(DFN,DATE,STATUS) ;
;Finds the primary means test for the specified patient and date.
;
;Input:
; DFN
; DATE - date to look for the MT, DT assumed if not passed (optional)
;Output:
; Function Value - 0 if no MT found, the ien otherwise
; STATUS - the status code of the MT (optional, pass by reference)
;
N NODE
;
S NODE=$$LST^DGMTU(DFN,$G(DATE),1)
S STATUS=$P(NODE,"^",4)
Q +NODE
;
GET(MTIEN,HARDSHIP) ;
;Given the ien of a MT (MTIEN), returns the hardship information
;
;Output:
; Function Value - returns 0 if there is no hardship determination, 1 otherwise
; HARDSHIP(
; "HARDSHIP?") - 0 or 1, corresponding to the HARDSHIP? field
; "EFFECTIVE") - the effective date of the hardship
; "SITE") - the stations number of the site that granted the hardship
; "BY") - the DUZ of the person that entered the hardship
; "REVIEW") - the review date
; "CURRENT STATUS") - patient's current MT status
; "DFN") - patient's DFN
; "TEST DATE") - DATE OF TEST
; "CTGRY CHNGD BY") - DUZ of person who last changed the category
; "DT/TM CTGRY CHNGD") -
; "AGREE") - AGREED TO PAY DEDUCTIBLE
; "MTIEN") - IEN of the means test
; "TEST STATUS") - TEST DETERMINED STATUS
; "REASON") - Hardship Reason
;
N NODE0,NODE2
S (NODE0,NODE2)=""
I MTIEN D
.S NODE0=$G(^DGMT(408.31,MTIEN,0))
.S NODE2=$G(^DGMT(408.31,MTIEN,2))
S HARDSHIP("MTIEN")=MTIEN
S HARDSHIP("TEST DATE")=$P(NODE0,"^")
S HARDSHIP("CURRENT STATUS")=$P(NODE0,"^",3)
S HARDSHIP("CTGRY CHNGD BY")=$P(NODE0,"^",8)
S HARDSHIP("DT/TM CTGRY CHNGD")=$P(NODE0,"^",9)
S HARDSHIP("AGREE")=$P(NODE0,"^",11)
S HARDSHIP("TEST STATUS")=$P(NODE2,"^",3)
S HARDSHIP("DFN")=$P(NODE0,"^",2)
S HARDSHIP("EFFECTIVE")=$P(NODE2,"^")
S HARDSHIP("SITE")=$P(NODE2,"^",4)
S HARDSHIP("BY")=$P(NODE0,"^",22)
S HARDSHIP("HARDSHIP?")=$P(NODE0,"^",20)
S HARDSHIP("REVIEW")=$P(NODE0,"^",21)
S HARDSHIP("YEAR")=$S(+NODE0:($E(NODE0,1,3)-1),1:"")
S HARDSHIP("REASON")=$P(NODE2,"^",9)
S HARDSHIP("EXPIRATION")=$P(NODE2,"^",13) ;DG*5.3*997
S HARDSHIP("EXPIRED")=$P(NODE2,"^",12) ;DG*5.3*997
Q +HARDSHIP("HARDSHIP?")
;
FIELD(SUB) ;
;Given the subscript used, returns the field number
I SUB="EFFECTIVE" Q 2.01
I SUB="SITE" Q 2.04
I SUB="BY" Q .22
I SUB="REASON" Q 2.09
I SUB="EXPIRATION" Q 2.13 ;DG*5.3*997
I SUB="EXPIRED" Q 2.12 ;DG*5.3*997
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:"")
;
EXT(SUB,VAL) ;
;Returns the external value of a field, given the subscript and the internal value
;
Q:$$FIELD(SUB) $$EXTERNAL^DILFD(408.31,$$FIELD(SUB),"F",VAL)
Q:((SUB="YEAR")&(VAL)) (+VAL)+1700
Q ""
;
STORE(HARDSHIP,ERROR) ;
;Stores the hardship
;
;Input:
; HARDSHIP - array containing hardship determination
;Output:
; Function Value - 0 on failure, 1 on success
; ERROR -an error message upon failure (optional,pass by reference)
;
N DATA,SUB
S SUB=""
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
Q $$UPD^DGENDBS(408.31,HARDSHIP("MTIEN"),.DATA,.ERROR)
;
DELETE(HARDSHIP,NOTIFY,ERROR) ;
;Deletes the hardship, then calls MT Event Driver
;Input:
; HARDSHIP - hardship array, pass by reference
; NOTIFY - if NOTIFY=1, means to notify HEC of deletion
;Output:
; Function Value - 1 on success, 0 on failure
; ERROR - error message (pass by reference)
;
N SUB,CURSTAT,TESTSTAT,SUCCESS
S SUCCESS=0
D PRIOR^DGMTHL1(.HARDSHIP)
S CURSTAT=$$GETCODE(HARDSHIP("CURRENT STATUS"))
S TESTSTAT=$$GETCODE(HARDSHIP("TEST STATUS"))
S SUB=""
F SUB="EFFECTIVE","SITE","BY","REVIEW","REASON" S HARDSHIP(SUB)=""
S HARDSHIP("HARDSHIP?")=0
I (CURSTAT="A")!(CURSTAT="G") D
.I (TESTSTAT="")!(TESTSTAT="C")!(TESTSTAT="P")!(TESTSTAT="G") D
..I (TESTSTAT'="") S HARDSHIP("CURRENT STATUS")=HARDSHIP("TEST STATUS") Q
..N NODE0
..S NODE0=$G(^DGMT(408.31,HARDSHIP("MTIEN"),0))
..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
..S HARDSHIP("CURRENT STATUS")=$$GETSTAT("C",1)
.S HARDSHIP("AGREE")=1
.S HARDSHIP("CTGRY CHNGD BY")=$G(DUZ)
.S HARDSHIP("DT/TM CTGRY CHNGD")=$$NOW^XLFDT
I $$STORE(.HARDSHIP,.ERROR) S SUCCESS=1 D AFTER^DGMTHL1(.HARDSHIP) I ($G(NOTIFY)=1) D DELETE^IVMPLOG(HARDSHIP("DFN"),HARDSHIP("TEST DATE"),,,1)
Q SUCCESS
;
GETCODE(STATUS) ;
;Gets the means test status code given the ien
Q:'$G(STATUS) ""
Q $P($G(^DG(408.32,STATUS,0)),"^",2)
;
GETNAME(STATUS) ;
;Gets the means test status name given the ien
Q:'$G(STATUS) ""
Q $P($G(^DG(408.32,STATUS,0)),"^")
;
GETSTAT(CODE,TYPE) ;
;Given the code and type of test, returns the ien of the status as the function value
;
Q:(CODE="") ""
;
N STATUS,NODE
S STATUS=0
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
Q $S(STATUS:STATUS,1:"")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMTH 5363 printed Apr 09, 2024@22:00:36 Page 2
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
+2 ;
FIND(DFN,DATE,STATUS) ;
+1 ;Finds the primary means test for the specified patient and date.
+2 ;
+3 ;Input:
+4 ; DFN
+5 ; DATE - date to look for the MT, DT assumed if not passed (optional)
+6 ;Output:
+7 ; Function Value - 0 if no MT found, the ien otherwise
+8 ; STATUS - the status code of the MT (optional, pass by reference)
+9 ;
+10 NEW NODE
+11 ;
+12 SET NODE=$$LST^DGMTU(DFN,$GET(DATE),1)
+13 SET STATUS=$PIECE(NODE,"^",4)
+14 QUIT +NODE
+15 ;
GET(MTIEN,HARDSHIP) ;
+1 ;Given the ien of a MT (MTIEN), returns the hardship information
+2 ;
+3 ;Output:
+4 ; Function Value - returns 0 if there is no hardship determination, 1 otherwise
+5 ; HARDSHIP(
+6 ; "HARDSHIP?") - 0 or 1, corresponding to the HARDSHIP? field
+7 ; "EFFECTIVE") - the effective date of the hardship
+8 ; "SITE") - the stations number of the site that granted the hardship
+9 ; "BY") - the DUZ of the person that entered the hardship
+10 ; "REVIEW") - the review date
+11 ; "CURRENT STATUS") - patient's current MT status
+12 ; "DFN") - patient's DFN
+13 ; "TEST DATE") - DATE OF TEST
+14 ; "CTGRY CHNGD BY") - DUZ of person who last changed the category
+15 ; "DT/TM CTGRY CHNGD") -
+16 ; "AGREE") - AGREED TO PAY DEDUCTIBLE
+17 ; "MTIEN") - IEN of the means test
+18 ; "TEST STATUS") - TEST DETERMINED STATUS
+19 ; "REASON") - Hardship Reason
+20 ;
+21 NEW NODE0,NODE2
+22 SET (NODE0,NODE2)=""
+23 IF MTIEN
Begin DoDot:1
+24 SET NODE0=$GET(^DGMT(408.31,MTIEN,0))
+25 SET NODE2=$GET(^DGMT(408.31,MTIEN,2))
End DoDot:1
+26 SET HARDSHIP("MTIEN")=MTIEN
+27 SET HARDSHIP("TEST DATE")=$PIECE(NODE0,"^")
+28 SET HARDSHIP("CURRENT STATUS")=$PIECE(NODE0,"^",3)
+29 SET HARDSHIP("CTGRY CHNGD BY")=$PIECE(NODE0,"^",8)
+30 SET HARDSHIP("DT/TM CTGRY CHNGD")=$PIECE(NODE0,"^",9)
+31 SET HARDSHIP("AGREE")=$PIECE(NODE0,"^",11)
+32 SET HARDSHIP("TEST STATUS")=$PIECE(NODE2,"^",3)
+33 SET HARDSHIP("DFN")=$PIECE(NODE0,"^",2)
+34 SET HARDSHIP("EFFECTIVE")=$PIECE(NODE2,"^")
+35 SET HARDSHIP("SITE")=$PIECE(NODE2,"^",4)
+36 SET HARDSHIP("BY")=$PIECE(NODE0,"^",22)
+37 SET HARDSHIP("HARDSHIP?")=$PIECE(NODE0,"^",20)
+38 SET HARDSHIP("REVIEW")=$PIECE(NODE0,"^",21)
+39 SET HARDSHIP("YEAR")=$SELECT(+NODE0:($EXTRACT(NODE0,1,3)-1),1:"")
+40 SET HARDSHIP("REASON")=$PIECE(NODE2,"^",9)
+41 ;DG*5.3*997
SET HARDSHIP("EXPIRATION")=$PIECE(NODE2,"^",13)
+42 ;DG*5.3*997
SET HARDSHIP("EXPIRED")=$PIECE(NODE2,"^",12)
+43 QUIT +HARDSHIP("HARDSHIP?")
+44 ;
FIELD(SUB) ;
+1 ;Given the subscript used, returns the field number
+2 IF SUB="EFFECTIVE"
QUIT 2.01
+3 IF SUB="SITE"
QUIT 2.04
+4 IF SUB="BY"
QUIT .22
+5 IF SUB="REASON"
QUIT 2.09
+6 ;DG*5.3*997
IF SUB="EXPIRATION"
QUIT 2.13
+7 ;DG*5.3*997
IF SUB="EXPIRED"
QUIT 2.12
+8 QUIT $SELECT(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:"")
+9 ;
EXT(SUB,VAL) ;
+1 ;Returns the external value of a field, given the subscript and the internal value
+2 ;
+3 if $$FIELD(SUB)
QUIT $$EXTERNAL^DILFD(408.31,$$FIELD(SUB),"F",VAL)
+4 if ((SUB="YEAR")&(VAL))
QUIT (+VAL)+1700
+5 QUIT ""
+6 ;
STORE(HARDSHIP,ERROR) ;
+1 ;Stores the hardship
+2 ;
+3 ;Input:
+4 ; HARDSHIP - array containing hardship determination
+5 ;Output:
+6 ; Function Value - 0 on failure, 1 on success
+7 ; ERROR -an error message upon failure (optional,pass by reference)
+8 ;
+9 NEW DATA,SUB
+10 SET SUB=""
+11 ;DG*5.3*997
FOR SUB="EFFECTIVE","SITE","BY","HARDSHIP?","REVIEW","CURRENT STATUS","CTGRY CHNGD BY","DT/TM CTGRY CHNGD","AGREE","REASON","EXPIRATION","EXPIRED"
SET DATA($$FIELD(SUB))=$GET(HARDSHIP(SUB))
+12 QUIT $$UPD^DGENDBS(408.31,HARDSHIP("MTIEN"),.DATA,.ERROR)
+13 ;
DELETE(HARDSHIP,NOTIFY,ERROR) ;
+1 ;Deletes the hardship, then calls MT Event Driver
+2 ;Input:
+3 ; HARDSHIP - hardship array, pass by reference
+4 ; NOTIFY - if NOTIFY=1, means to notify HEC of deletion
+5 ;Output:
+6 ; Function Value - 1 on success, 0 on failure
+7 ; ERROR - error message (pass by reference)
+8 ;
+9 NEW SUB,CURSTAT,TESTSTAT,SUCCESS
+10 SET SUCCESS=0
+11 DO PRIOR^DGMTHL1(.HARDSHIP)
+12 SET CURSTAT=$$GETCODE(HARDSHIP("CURRENT STATUS"))
+13 SET TESTSTAT=$$GETCODE(HARDSHIP("TEST STATUS"))
+14 SET SUB=""
+15 FOR SUB="EFFECTIVE","SITE","BY","REVIEW","REASON"
SET HARDSHIP(SUB)=""
+16 SET HARDSHIP("HARDSHIP?")=0
+17 IF (CURSTAT="A")!(CURSTAT="G")
Begin DoDot:1
+18 IF (TESTSTAT="")!(TESTSTAT="C")!(TESTSTAT="P")!(TESTSTAT="G")
Begin DoDot:2
+19 IF (TESTSTAT'="")
SET HARDSHIP("CURRENT STATUS")=HARDSHIP("TEST STATUS")
QUIT
+20 NEW NODE0
+21 SET NODE0=$GET(^DGMT(408.31,HARDSHIP("MTIEN"),0))
+22 ;Income <= GMT Threshold
IF CURSTAT="A"
IF (($PIECE(NODE0,U,4)-$PIECE(NODE0,U,15))'>$PIECE(NODE0,U,27))
SET HARDSHIP("CURRENT STATUS")=$$GETSTAT("G",1)
QUIT
+23 SET HARDSHIP("CURRENT STATUS")=$$GETSTAT("C",1)
End DoDot:2
+24 SET HARDSHIP("AGREE")=1
+25 SET HARDSHIP("CTGRY CHNGD BY")=$GET(DUZ)
+26 SET HARDSHIP("DT/TM CTGRY CHNGD")=$$NOW^XLFDT
End DoDot:1
+27 IF $$STORE(.HARDSHIP,.ERROR)
SET SUCCESS=1
DO AFTER^DGMTHL1(.HARDSHIP)
IF ($GET(NOTIFY)=1)
DO DELETE^IVMPLOG(HARDSHIP("DFN"),HARDSHIP("TEST DATE"),,,1)
+28 QUIT SUCCESS
+29 ;
GETCODE(STATUS) ;
+1 ;Gets the means test status code given the ien
+2 if '$GET(STATUS)
QUIT ""
+3 QUIT $PIECE($GET(^DG(408.32,STATUS,0)),"^",2)
+4 ;
GETNAME(STATUS) ;
+1 ;Gets the means test status name given the ien
+2 if '$GET(STATUS)
QUIT ""
+3 QUIT $PIECE($GET(^DG(408.32,STATUS,0)),"^")
+4 ;
GETSTAT(CODE,TYPE) ;
+1 ;Given the code and type of test, returns the ien of the status as the function value
+2 ;
+3 if (CODE="")
QUIT ""
+4 ;
+5 NEW STATUS,NODE
+6 SET STATUS=0
+7 FOR
SET STATUS=$ORDER(^DG(408.32,STATUS))
if 'STATUS
QUIT
SET NODE=$GET(^DG(408.32,STATUS,0))
IF $PIECE(NODE,"^",2)=CODE
IF $PIECE(NODE,"^",19)=TYPE
QUIT
+8 QUIT $SELECT(STATUS:STATUS,1:"")
