source: FOIAVistA/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCGUIA.m@ 905

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

initial load of FOIAVistA 6/30/08 version
File size: 8.1 KB
Line 
1GMRCGUIA ;SLC/DCM,JFR - File Consult actions from GUI ;7/8/03 07:36
2 ;;3.0;CONSULT/REQUEST TRACKING;**1,4,12,15,22,35**;DEC 27, 1997
3 ;
4 ; This routine invokes IA #2638,#2926
5 ;
6NEW(DFN,GMRCDA,GMRCLOC,GMRCTYPE,GMRCSVC,GMRCPROV,GMRCURG,GMRCPLI,GMRCNP,GMRCATN,GMRCINOT,GMRCDIAG,GMRCRFQ) ;Add a new consult for a patient.
7 ;DFN=Patient ^DPT( file number
8 ;GMRCRFQ=Reason For Request, why the consult is being ordered. Passed in as
9 ; an array
10 ;GMRCDIAG=Povisional diagnosis; what is suspected to be the problem
11 ;GMRCTYPE=Request type -Consult or Procedure
12 ;GMRCLOC=Patient location.
13 ;GMRCDA=Date Time of Request
14 ;GMRCSVC=To Service; consulting service
15 ;GMRCLOC=Hospital Location ordering consult
16 ;GMRCPR=If a procedure, the procedure ordered (pointer to file 101)
17 ;GMRCURG=Urgency of request (stat, routine, etc) from file 101
18 ;GMRCPLI=Place of consultation (bedside, consultants choice, etc.) from file 101
19 ;GMRCPROV=Sending Provider
20 ;GMRCATN=if consult is to go to a specific provider, this provider is identified here.
21 ;GMRCINOT=Service provided as Inpatient or Outpatient
22 N DIC,DLAYGO,Y,DIE,GMRCADUZ,X,GMRCO,DR
23 S DIC="^GMR(123,",DIC(0)="L",X="""N""",DLAYGO=123 D ^DIC K DLAYGO
24 S (DA,GMRCO)=+Y,GMRCSTS=5,GMRCA=1,DIE=DIC
25 L +^GMR(123,GMRC0)
26 S DR=".02////^S X=DFN;.04////^S X=GMRCLOC;1////^S X=GMRCSVC;3////^S X=GMRCDA;4////^S X=GMRCPR;5////^S X=GMRCURG;6////^S X=GMRCPLI"_$S(GMRCATN]"":"7////^S X=GMRCATN",1:"")
27 D ^DIE
28 S DR="8////^S X=GMRCSTS;9////^S X=GMRCA;10////^S X=GMRCPROV;11////^S X=GMRCATN;13////^S X=GMRCTYPE;14////^S X=GMRCINOT"_$S($D(GMRCDIAG):"30:////^S X=GMRCDIAG",1:"")
29 D ^DIE L -^GMR(123,GMRCO)
30 I $O(GMRCRFQ(0)) D REASON^GMRCGUIB(GMRCO,GMRCRFQ,GMRCDA)
31 D EN^GMRCHL7(DFN,GMRCDA,GMRCTYPE,$G(GMRCRB),"NW",DUZ,$G(VISIT),"")
32 D EXIT
33 Q
34 ;
35RC(GMRCO,GMRCORNP,GMRCAD,GMRCMT,GMRCDUZ) ;Receive consult into service
36 ;
37 ;Input variables:
38 ;GMRCO - The internal file number of the consult from File 123
39 ;GMRCORNP - Name of the person who actually 'Received'the consult
40 ;GMRCDUZ - DUZ of person entering the consult as being 'RECEIVED'.
41 ;GMRCAD - Actual date time that consult was received into the service.
42 ;GMRCMT - array of comments if entered (by reference)
43 ; ARRAY(1)="FIRST LINE OF COMMENT"
44 ; ARRAY(2)="SECOND LINE OF COMMENT"
45 ;GMRCDUZ - DUZ of person entering the consult as being 'RECEIVED'
46 ;
47 ;Output:
48 ;GMRCERR - Error Condition Code: 0 = NO error, 1=error
49 ;GMRCERMS - Error message or null
50 ; returned as GMRCERR^GMRCERMS
51 ;
52 N DFN,GMRCSTS,GMRCNOW,GMRCERR,GMRCERMS
53 S GMRCERR=0,GMRCERMS="",GMRCNOW=$$NOW^XLFDT
54 S:$G(GMRCAD)="" GMRCAD=GMRCNOW
55 S:'$G(GMRCDUZ) GMRCDUZ=DUZ
56 S DFN=$P($G(^GMR(123,GMRCO,0)),"^",2) I DFN="" S GMRCERR="1",GMRCERMS="Not A Valid Consult - File Not Found." D EXIT Q GMRCERR_"^"_GMRCERMS
57 S GMRCSTS=6,GMRCA=21
58 D STATUS^GMRCP I $D(GMRCQUT) D EXIT Q GMRCERR_"^"_GMRCERMS
59 I '$O(GMRCMT(0)) D AUDIT^GMRCP
60 I $O(GMRCMT(0)) D
61 . S DA=$$SETDA^GMRCGUIB
62 . D SETCOM^GMRCGUIB(.GMRCMT,GMRCDUZ)
63 D EN^GMRCHL7(DFN,GMRCO,"","","SC",GMRCORNP,"","")
64 D EXIT
65 Q GMRCERR_"^"_GMRCERMS
66 ;
67DC(GMRCO,GMRCORNP,GMRCAD,GMRCACTM,GMRCOM) ;Discontinue or Deny a consult
68 ;
69 ;Input variables:
70 ;GMRCO - Internal file number of consult from File 123
71 ;GMRCORNP - Provider who Discontinued or Denied consult
72 ;GMRCAD - FM date/time of actual activity.
73 ;GMRCACTM - set to "DY" if 'CANCELLED'(old DENY)
74 ; set to "DC" if consult is Discontinued
75 ;GMRCOM - Comment array containing explanation of action
76 ; Passed by reference in the following form :
77 ; ARRAY(1)="xxx xxx xxx"
78 ; ARRAY(2)="XXX XXX"
79 ; ARRAY(3)="XXX XXX xx", etc.
80 ; Comment is a required field when consult is denied or discontinued.
81 ;
82 ;Output:
83 ;GMRCERR=Error Flag: 0 if no error, 1 if error occurred
84 ;GMRCERMS - Error message or null
85 ; returned as GMRCERR^GMRCERMS
86 ;
87 N GMRCDUZ,DFN,GMRCNOW,GMRCSTS,GMRCERR,GMRCERMS,GMRCADUZ,GMRCTRLC
88 S GMRCERR=0,GMRCERMS=""
89 S GMRCDUZ=DUZ,GMRCERR=0,GMRCERMS="",GMRCNOW=$$NOW^XLFDT
90 K GMRCQUT
91 S:$G(GMRCAD)="" GMRCAD=GMRCNOW
92 S DFN=$P($G(^GMR(123,GMRCO,0)),"^",2) I DFN="" S GMRCERR="1",GMRCERMS="Not A Valid Consult - File Not Found." D EXIT Q GMRCERR_"^"_GMRCERMS
93 I '$D(GMRCOM) S GMRCERR=1,GMRCERMS="Comments are required for this action." D EXIT Q GMRCERR_"^"_GMRCERMS
94 S GMRCSTS=$P(^ORD(100.01,$P(^GMR(123,GMRCO,0),"^",12),0),U,2)
95 I GMRCSTS="dc" S GMRCERR=1,GMRCERMS="Order Has Already Been Discontinued." D EXIT Q GMRCERR_"^"_GMRCERMS
96 I GMRCSTS="ca" S GMRCERR=1,GMRCERMS="Order Has Already Been Cancelled." D EXIT Q GMRCERR_"^"_GMRCERMS
97 I GMRCSTS="comp" S GMRCERR=1,GMRCERMS="Order Has Already Been Completed." D EXIT Q GMRCERR_"^"_GMRCERMS
98 S GMRCA=$S(GMRCACTM="DC":6,1:19),GMRCSTS=$S(GMRCA=6:1,1:13)
99 D STATUS^GMRCP I $D(GMRCQUT) D EXIT Q GMRCERR_"^"_GMRCERMS
100 I GMRCACTM="DC",$$DCPRNT^GMRCUTL1(GMRCO,DUZ) D PRNT^GMRCUTL1("",GMRCO)
101 S DA=$$SETDA^GMRCGUIB D SETCOM^GMRCGUIB(.GMRCOM)
102 S GMRCOM(0)=DA
103 S GMRCTRLC=$S(GMRCACTM="DC":"OD",1:"OC")
104 D EN^GMRCHL7(DFN,GMRCO,$G(GMRCTYPE),$G(GMRCRB),GMRCTRLC,GMRCORNP,$G(GMRCVSIT),.GMRCOM,,GMRCAD)
105 S GMRCORTX=$S(GMRCACTM="DY":"Cancelled",1:"Discontinued")_" consult "
106 S GMRCORTX=GMRCORTX_$$ORTX^GMRCAU(+GMRCO)
107 S GMRCADUZ="",GMRCFL=0
108 I GMRCACTM="DC" D
109 . S GMRCFL=$$DCNOTE^GMRCADC(GMRCO,DUZ) ;NOTIFY SERVICE ON DC ?
110 I +$P($G(^GMR(123,+GMRCO,0)),"^",14),$P(^(0),"^",14)'=DUZ D
111 . S GMRCADUZ($P(^(0),"^",14))=""
112 ;send notification
113 N NOTYPE S NOTYPE=$S(GMRCA=6:23,1:30)
114 D MSG^GMRCP(DFN,GMRCORTX,+GMRCO,NOTYPE,.GMRCADUZ,GMRCFL)
115 D EXIT
116 Q GMRCERR_"^"_GMRCERMS
117 ;
118FR(GMRCO,GMRCSS,GMRCORNP,GMRCATTN,GMRCURGI,GMRCOM,GMRCAD) ;FWD consult
119 ;to another service
120 ;
121 ;Input variables:
122 ;GMRCO=File 123 IEN of the consult record
123 ;GMRCSS=service being forwarded to; ptr to REQUEST SERVICES (#123.5)
124 ;GMRCORNP=Provider Responsible for action
125 ;GMRCATTN=NEW PERSON to whose attention action should be directed
126 ;GMRCURGI=urgency from PROTOCOL(#101) file
127 ;GMRCOM=Comment array containing explanation of action
128 ; Passed by reference in the following form :
129 ; ARRAY(1)="xxx xxx xxx"
130 ; ARRAY(2)="XXX XXX"
131 ; ARRAY(3)="XXX XXX xx", etc.
132 ;GMRCAD=FM date/time of actual activity
133 ;
134 ;Output:
135 ; GMRCERR=Error Flag: 0 if no error, 1 if error occurred
136 ; GMRCERMS - Error message or null
137 ; returned as GMRCERR^GMRCERMS
138 ;
139 N DR,GMRCDUZ,GMRCNOW,GMRCFF,GMRCFR,GMRCADUZ,GMRCURG
140 N GMRCERR,GMRCERMS,GMRCIROL,GMRCINM,GMRCIROU
141 S GMRCERR=0,GMRCERMS=""
142 S DFN=$P(^GMR(123,+GMRCO,0),U,2)
143 S GMRCDUZ=DUZ,GMRCNOW=$$NOW^XLFDT
144 S:'$G(GMRCAD) GMRCAD=GMRCNOW ;Actual FM date/time consult was FWD'd
145 S:'$G(GMRCURGI) GMRCURGI=$P(^GMR(123,GMRCO,0),U,9)
146 S GMRCA=17,GMRCSTS=5
147 S GMRCFF=$P($G(^GMR(123.5,+GMRCSS,123)),U,9) ;printed to new serv
148 S GMRCFR=$P($G(^GMR(123,+GMRCO,0)),"^",5) ;Get current service
149 S DIE="^GMR(123,",DA=GMRCO,DR=""
150 I $D(^GMR(123.5,+GMRCSS,"IFC")) D ; if fwd to IFC serv, get extra flds
151 . S GMRCIROU=$P(^GMR(123.5,+GMRCSS,"IFC"),U) Q:GMRCIROU="" ;no rout fac
152 . S GMRCINM=$P(^GMR(123.5,+GMRCSS,"IFC"),U,2) Q:GMRCINM="" ;no serv nm
153 . S GMRCA=25,GMRCIROL="P"
154 . S DR=".07////^S X=GMRCIROU;.125////^S X=GMRCIROL;.131///^S X=GMRCINM;"
155 S DR=DR_"1////^S X=$G(GMRCSS);5////^S X=$G(GMRCURGI);8////^S X=$G(GMRCSTS);9////^S X=$G(GMRCA);.1///@"_$S($L($G(GMRCATTN)):";7////^S X=GMRCATTN",1:"")
156 L +^GMR(123,GMRCO):3 I '$T K DIE,DA,DR S GMRCERR=1,GMRCERMS="Data Not Filed - File In Use By Another User." D EXIT Q GMRCERR_"^"_GMRCERMS
157 D ^DIE L -^GMR(123,GMRCO) K DIE,DA,DR
158 S DA=$$SETDA^GMRCGUIB D SETCOM^GMRCGUIB(.GMRCOM)
159 S GMRCURG=$P($G(^ORD(101,+GMRCURGI,0)),"^",2)
160 D DEM^GMRCU ;sets GMRCRB and other variables
161 D TYPE^GMRCAFRD ;sets GMRCTYPE
162 D FRMSG^GMRCAFRD ;create XX HL7 message for OE/RR and send alert
163 D EXIT
164 Q GMRCERR_"^"_GMRCERMS
165 ;
166RT(GMRCO,TMPGLOB) ;Set ^TMP("GMRCR",$J,"DT", with results from med and TIU
167 ;GMRCO=IEN of consult from file 123
168 ;Set TMPGLOB to a ^TMP global other than ^TMP("GMRCR",$J,"MCAR", or ^TMP("GMRCR",$J,"RES", i.e., S TMPGLOB="^TMP(""GMRCR"",$J,""RT"")"'
169 Q:'$G(GMRCO)
170 K @TMPGLOB
171 S GMRCDVL="",$P(GMRCDVL,"-",41)=""
172 S GMRCSR=$P(^GMR(123,+GMRCO,0),"^",15),GMRCTUFN=$P(^(0),"^",20)
173 S GMRCRTFL=$S('+GMRCSR&('GMRCTUFN):1,1:0)
174 ;
175 D GETRSLT^GMRCART(TMPGLOB)
176 ;
177 D EXIT
178 Q
179EXIT ;kill off variables for exit from actions
180 K GMRCA,GMRCDVL,GMRCSR,GMRCRTFL,GMRCFL,GMRCORNP,GMRCQUT,GMRCSTS,GMRCTUFN
181 K GMRCRTFL,GMRCADUZ,GMRCORTX
182 Q
Note: See TracBrowser for help on using the repository browser.