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