source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGMTH.m@ 1704

Last change on this file since 1704 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.9 KB
RevLine 
[613]1DGMTH ;ALB/CJM/TDM MEANS TEST HARDSHIP ; 8/29/02 4:54pm
2 ;;5.3;Registration;**182,456**;Aug 13, 1993
3 ;
4FIND(DFN,DATE,STATUS) ;
5 ;Finds the primary means test for the specified patient and date.
6 ;
7 ;Input:
8 ; DFN
9 ; DATE - date to look for the MT, DT assumed if not passed (optional)
10 ;Output:
11 ; Function Value - 0 if no MT found, the ien otherwise
12 ; STATUS - the status code of the MT (optional, pass by reference)
13 ;
14 N NODE
15 ;
16 S NODE=$$LST^DGMTU(DFN,$G(DATE),1)
17 S STATUS=$P(NODE,"^",4)
18 Q +NODE
19 ;
20GET(MTIEN,HARDSHIP) ;
21 ;Given the ien of a MT (MTIEN), returns the hardship information
22 ;
23 ;Output:
24 ; Function Value - returns 0 if there is no hardship determination, 1 otherwise
25 ; HARDSHIP(
26 ; "HARDSHIP?") - 0 or 1, corresponding to the HARDSHIP? field
27 ; "EFFECTIVE") - the effective date of the hardship
28 ; "SITE") - the stations number of the site that granted the hardship
29 ; "BY") - the DUZ of the person that entered the hardship
30 ; "REVIEW") - the review date
31 ; "CURRENT STATUS") - patient's current MT status
32 ; "DFN") - patient's DFN
33 ; "TEST DATE") - DATE OF TEST
34 ; "CTGRY CHNGD BY") - DUZ of person who last changed the category
35 ; "DT/TM CTGRY CHNGD") -
36 ; "AGREE") - AGREED TO PAY DEDUCTIBLE
37 ; "MTIEN") - IEN of the means test
38 ; "TEST STATUS") - TEST DETERMINED STATUS
39 ; "REASON") - Hardship Reason
40 ;
41 N NODE0,NODE2
42 S (NODE0,NODE2)=""
43 I MTIEN D
44 .S NODE0=$G(^DGMT(408.31,MTIEN,0))
45 .S NODE2=$G(^DGMT(408.31,MTIEN,2))
46 S HARDSHIP("MTIEN")=MTIEN
47 S HARDSHIP("TEST DATE")=$P(NODE0,"^")
48 S HARDSHIP("CURRENT STATUS")=$P(NODE0,"^",3)
49 S HARDSHIP("CTGRY CHNGD BY")=$P(NODE0,"^",8)
50 S HARDSHIP("DT/TM CTGRY CHNGD")=$P(NODE0,"^",9)
51 S HARDSHIP("AGREE")=$P(NODE0,"^",11)
52 S HARDSHIP("TEST STATUS")=$P(NODE2,"^",3)
53 S HARDSHIP("DFN")=$P(NODE0,"^",2)
54 S HARDSHIP("EFFECTIVE")=$P(NODE2,"^")
55 S HARDSHIP("SITE")=$P(NODE2,"^",4)
56 S HARDSHIP("BY")=$P(NODE0,"^",22)
57 S HARDSHIP("HARDSHIP?")=$P(NODE0,"^",20)
58 S HARDSHIP("REVIEW")=$P(NODE0,"^",21)
59 S HARDSHIP("YEAR")=$S(+NODE0:($E(NODE0,1,3)-1),1:"")
60 S HARDSHIP("REASON")=$P(NODE2,"^",9)
61 Q +HARDSHIP("HARDSHIP?")
62 ;
63FIELD(SUB) ;
64 ;Given the subscript used, returns the field number
65 I SUB="EFFECTIVE" Q 2.01
66 I SUB="SITE" Q 2.04
67 I SUB="BY" Q .22
68 I SUB="REASON" Q 2.09
69 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:"")
70 ;
71EXT(SUB,VAL) ;
72 ;Returns the external value of a field, given the subscript and the internal value
73 ;
74 Q:$$FIELD(SUB) $$EXTERNAL^DILFD(408.31,$$FIELD(SUB),"F",VAL)
75 Q:((SUB="YEAR")&(VAL)) (+VAL)+1700
76 Q ""
77 ;
78STORE(HARDSHIP,ERROR) ;
79 ;Stores the hardship
80 ;
81 ;Input:
82 ; HARDSHIP - array containing hardship determination
83 ;Output:
84 ; Function Value - 0 on failure, 1 on success
85 ; ERROR -an error message upon failure (optional,pass by reference)
86 ;
87 N DATA,SUB
88 S SUB=""
89 F SUB="EFFECTIVE","SITE","BY","HARDSHIP?","REVIEW","CURRENT STATUS","CTGRY CHNGD BY","DT/TM CTGRY CHNGD","AGREE","REASON" S DATA($$FIELD(SUB))=HARDSHIP(SUB)
90 Q $$UPD^DGENDBS(408.31,HARDSHIP("MTIEN"),.DATA,.ERROR)
91 ;
92DELETE(HARDSHIP,NOTIFY,ERROR) ;
93 ;Deletes the hardship, then calls MT Event Driver
94 ;Input:
95 ; HARDSHIP - hardship array, pass by reference
96 ; NOTIFY - if NOTIFY=1, means to notify HEC of deletion
97 ;Output:
98 ; Function Value - 1 on success, 0 on failure
99 ; ERROR - error message (pass by reference)
100 ;
101 N SUB,CURSTAT,TESTSTAT,SUCCESS
102 S SUCCESS=0
103 D PRIOR^DGMTHL1(.HARDSHIP)
104 S CURSTAT=$$GETCODE(HARDSHIP("CURRENT STATUS"))
105 S TESTSTAT=$$GETCODE(HARDSHIP("TEST STATUS"))
106 S SUB=""
107 F SUB="EFFECTIVE","SITE","BY","REVIEW","REASON" S HARDSHIP(SUB)=""
108 S HARDSHIP("HARDSHIP?")=0
109 I (CURSTAT="A")!(CURSTAT="G") D
110 .I (TESTSTAT="")!(TESTSTAT="C")!(TESTSTAT="P")!(TESTSTAT="G") D
111 ..I (TESTSTAT'="") S HARDSHIP("CURRENT STATUS")=HARDSHIP("TEST STATUS") Q
112 ..N NODE0
113 ..S NODE0=$G(^DGMT(408.31,HARDSHIP("MTIEN"),0))
114 ..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
115 ..S HARDSHIP("CURRENT STATUS")=$$GETSTAT("C",1)
116 .S HARDSHIP("AGREE")=1
117 .S HARDSHIP("CTGRY CHNGD BY")=$G(DUZ)
118 .S HARDSHIP("DT/TM CTGRY CHNGD")=$$NOW^XLFDT
119 I $$STORE(.HARDSHIP,.ERROR) S SUCCESS=1 D AFTER^DGMTHL1(.HARDSHIP) I ($G(NOTIFY)=1) D DELETE^IVMPLOG(HARDSHIP("DFN"),HARDSHIP("TEST DATE"),,,1)
120 Q SUCCESS
121 ;
122GETCODE(STATUS) ;
123 ;Gets the means test status code given the ien
124 Q:'$G(STATUS) ""
125 Q $P($G(^DG(408.32,STATUS,0)),"^",2)
126 ;
127GETNAME(STATUS) ;
128 ;Gets the means test status name given the ien
129 Q:'$G(STATUS) ""
130 Q $P($G(^DG(408.32,STATUS,0)),"^")
131 ;
132GETSTAT(CODE,TYPE) ;
133 ;Given the code and type of test, returns the ien of the status as the function value
134 ;
135 Q:(CODE="") ""
136 ;
137 N STATUS,NODE
138 S STATUS=0
139 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
140 Q $S(STATUS:STATUS,1:"")
Note: See TracBrowser for help on using the repository browser.