source: FOIAVistA/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCDIS.m@ 1704

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

initial load of FOIAVistA 6/30/08 version

File size: 5.6 KB
Line 
1GMRCDIS ;SLC/JFR - LM ROUTINE TO DISASSOCIATE MED RESULTS; 11/5/01 11:20
2 ;;3.0;CONSULT/REQUEST TRACKING;**15,22**;DEC 27, 1997
3 ;
4 ; This routine invokes IA #2324,#3042,#3120
5 ;
6EN ;invoke list template
7 D EN^VALM("GMRC DISASSOC RESULTS")
8 Q
9HDR ;format list template header
10 N GMRCVTIT
11 S GMRCVTIT="Procedure/Medicine Resulting"
12 D HDR^GMRCSLDT
13 S VALMHDR(2)="Consult No.: "_GMRCO
14 S VALMHDR(2)=$$SETSTR^VALM1("Associated Medicine Results",VALMHDR(2),30,28)
15 Q
16PHDR ;set protocols into actions
17 S VALMSG=$$CJ^XLFSTR("Select action or item number ?? for help",80)
18 S XQORM("M")=3
19 D SHOW^VALM
20 S XQORM("#")=$O(^ORD(101,"B","GMRCACT SELECT MED RESULT",0))_"^1:"_VALMCNT
21 S XQORM("KEY","EX")=$O(^ORD(101,"B","GMRCACT QUIT",0))_"^1"
22 S XQORM("KEY","Q")=$O(^ORD(101,"B","GMRCACT QUIT",0))_"^1"
23 S XQORM("KEY","CLOSE")=$O(^ORD(101,"B","GMRCACT QUIT",0))_"^1"
24 S XQORM("KEY","NX")=$O(^ORD(101,"B","GMRCACT NEXT SCREEN",0))_"^1"
25 S XQORM("KEY","DM")=$O(^ORD(101,"B","GMRCACT DISASSOC MED RSLT",0))_"^1"
26 S XQORM("KEY","DR")=$O(^ORD(101,"B","GMRCACT DISPLAY MED RESULT",0))_"^1"
27 Q
28INIT ; set up array into ^TMP("GMRCR",$J,"DT"...
29 ; should already have it
30 S VALMCNT=$O(^TMP("GMRCR",$J,"DT",999999),-1),VALMBG=1
31 Q
32GETRES(GMRCO) ; get associated MEDICINE results and format
33 N RES,GMRCMCR,CNT,DATA
34 S RES=0,CNT=1
35 F S RES=$O(^GMR(123,GMRCO,50,RES)) Q:'RES D
36 . I $G(^GMR(123,GMRCO,50,RES,0))'["MCAR" Q
37 . S GMRCMCR=$$SINGLE^MCAPI(^GMR(123,GMRCO,50,RES,0))
38 . S DATA=""
39 . S DATA=$$SETSTR^VALM1(CNT,DATA,2,$L(CNT))
40 . S DATA=$$SETSTR^VALM1($P(GMRCMCR,U),DATA,6,23)
41 . S DATA=$$SETSTR^VALM1($P(GMRCMCR,U,6),DATA,30,$L($P(GMRCMCR,U,6)))
42 . S DATA=$$SETSTR^VALM1($P(GMRCMCR,U,7),DATA,50,$L($P(GMRCMCR,U,7)))
43 . S ^TMP("GMRCR",$J,"DT",CNT,0)=DATA
44 . S ^TMP("GMRCR",$J,"DT",CNT,1)=^GMR(123,GMRCO,50,RES,0)
45 . S CNT=CNT+1
46 Q
47DIS(GMRCO) ;select consult and start disassoc process
48 N GMRCQUT,GMRCQIT,GMRCSS,GMRCMSG
49 I '+$G(GMRCO) D SELECT^GMRCA2(.GMRCO) I $D(GMRCQUT) Q
50 I '+$G(GMRCO) Q
51 I '$$LOCK^GMRCA1(GMRCO) Q
52 S GMRCMSG=$$REMUSR(GMRCO,DUZ) I '+GMRCMSG D Q
53 . N MSG
54 . I '$L($P(GMRCMSG,U,2)) D
55 .. S MSG="You are not authorized to disassociate results."
56 . D EXAC^GMRCADC($S($D(MSG):MSG,1:$P(GMRCMSG,U,2)))
57 D GETRES(GMRCO)
58 D EN
59 D UNLOCK^GMRCA1(GMRCO)
60 Q
61EXIT ;
62 K ^TMP("GMRCR",$J,"DT")
63 Q
64EN1(GMRCRSLT) ; select result and verify remove action
65 I '+$G(^TMP("GMRCR",$J,"DT",1,1)) D Q ;no result there
66 . D EXAC^GMRCADC("There are no results to remove")
67 N RESTXT,RESULT,DIR,X,Y,DUOUT,DTOUT,DIROUT
68 I '$G(ITEM),'$G(GMRCMEDR) D Q:'ITEM
69 . S ITEM=$$SELECT^GMRCMED(VALMCNT)
70 . D SET^GMRCMED(ITEM)
71 I $G(GMRCMEDR) S ITEM=GMRCMEDR
72 D FULL^VALM1
73 S RESTXT=$E(^TMP("GMRCR",$J,"DT",ITEM,0),6,80)
74 S RESULT=^TMP("GMRCR",$J,"DT",ITEM,1) Q:'+RESULT
75 S DIR(0)="YA",DIR("B")="NO"
76 S DIR("A",1)="",DIR("A",2)=" "_RESTXT,DIR("A",3)=""
77 S DIR("A")="Are you sure you want to disassociate this result? "
78 D ^DIR I Y<1 Q
79 D REMOVE(GMRCO,RESULT)
80 Q
81REMOVE(GMRCO,RSLT,GMRCAD,GMRCORNP) ;disassociate result
82 ; remove rslt, log actv, update sts, send alerts
83 ; Input:
84 ; GMRCO - ien from file 123
85 ; RSLT - medicine result in var ptr form (e.g. "19;MCAR(691.5,")
86 ; GMRCAD - FM date/time of action (optional)
87 ; GMRCORNP - DUZ of person performing action (optional)
88 ;
89 N GMRCRES,DIK,DA,GMRCQUT,GMRCQIT
90 S GMRCRES=$O(^GMR(123,+GMRCO,50,"B",RSLT,0)) I 'GMRCRES D Q
91 . D EXAC^GMRCADC("This result is no longer associated with the request")
92 ; delete result entry
93 S DA(1)=+GMRCO,DA=GMRCRES,DIK="^GMR(123,"_DA(1)_",50," D ^DIK
94 I $P(^GMR(123,+GMRCO,0),U,15)=RSLT D
95 . N DA,DIE,DR
96 . S DIE="^GMR(123,",DA=+GMRCO,DR="11///@" D ^DIE
97 ; update activity tracking
98 N GMRCA,GMRCRSLT
99 S GMRCA=12,GMRCRSLT=RSLT
100 D AUDIT^GMRCP
101 ; Update status back to active if not completed before
102 N GMRCDFN,GMRCTYP
103 S GMRCDFN=$P(^GMR(123,+GMRCO,0),U,2)
104 I $$STSCHG(GMRCO) D
105 . N GMRCSTS
106 . S GMRCSTS=6 D STATUS^GMRCP
107 . ; update CPRS
108 . S GMRCTYP=$P(^GMR(123,+GMRCO,0),U,17)
109 . D EN^GMRCHL7(GMRCDFN,+GMRCO,GMRCTYP,"","SC",$G(GMRCORNP),"")
110 ; send notification?
111 I '$G(GMRCORNP) S GMRCORNP=DUZ
112 I GMRCORNP'=$P(^GMR(123,+GMRCO,0),U,14) D
113 . Q:'$P(^GMR(123,+GMRCO,0),U,14)
114 . N GMRCADUZ,GMRCORTX
115 . S GMRCADUZ($P(^GMR(123,+GMRCO,0),U,14))=""
116 . S GMRCORTX="Result removed from "_$$ORTX^GMRCAU(+GMRCO)
117 . D MSG^GMRCP(GMRCDFN,GMRCORTX,GMRCO,27,.GMRCADUZ,0)
118 Q
119 ;
120STSCHG(GMRCIEN) ;completed before or go back
121 I $O(^GMR(123,GMRCIEN,50,0)) Q 0 ;still at least one result
122 I $O(^GMR(123,GMRCIEN,51,0)) Q 0 ;still at least one remote result
123 N CHG,ACT,I S ACT=0,CHG=1,I=0
124 F S I=$O(^GMR(123,GMRCIEN,40,I)) Q:'I D
125 . S ACT(0)=^GMR(123,GMRCIEN,40,I,0),ACT(2)=$G(^(2))
126 . I $P(ACT(0),U,2)=10,('$L($P(ACT(0),U,9))&('$L($P(ACT(2),U,4)))) D
127 .. S CHG=0 ; admin completed before if no results
128 . Q
129 Q CHG
130 ;
131REFRESH(GMRCIEN) ;re-build list of associated results
132 I $G(GMRCMEDR) D RESETIT^GMRCMED(GMRCMEDR)
133 K ^TMP("GMRCR",$J,"DT"),GMRCMEDR
134 D GETRES(GMRCIEN)
135 I '$O(^TMP("GMRCR",$J,"DT",0)) D
136 . S ^TMP("GMRCR",$J,"DT",1,0)="No further results to disassociate"
137 S VALMCNT=$O(^TMP("GMRCR",$J,"DT",""),-1)
138 S VALMBCK="R"
139 Q
140REMUSR(GMRCIEN,USER) ; check to see if user is authorized to remove results
141 N GMRCSS,GMRCCLS,RES
142 I '+$P($G(^GMR(123,GMRCIEN,0)),U,8) Q 0
143 S GMRCSS=$P(^GMR(123,GMRCIEN,0),U,5) I 'GMRCSS Q 0 ;no service
144 S GMRCCLS=$P($G(^GMR(123.5,GMRCSS,1)),U,6) I 'GMRCCLS Q 0 ;no class
145 I '$O(^GMR(123,GMRCIEN,50,0)) Q "0^There are no results associated with this request." ;no results to remove
146 S RES=""
147 F S RES=$O(^GMR(123,GMRCIEN,50,"B",RES)) Q:RES="" Q:RES["MCAR"
148 I RES="" Q "0^There are no Medicine results associated with this request." ;no med results
149 I '$G(USER) S USER=DUZ
150 I $$ISA^USRLM(USER,GMRCCLS) Q 1 ;part of USR CLASS in fld 1.06
151 Q 0
Note: See TracBrowser for help on using the repository browser.