source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORQQCN1.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 5.3 KB
Line 
1ORQQCN1 ; slc/REV - Functions for GUI consult actions - RPCs for GMRCGUIA ; 8-NOV-2000 14:49:16 [1/9/01 10:39am]
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,98,85,109,148**;Dec 17, 1997
3 ;
4RC(Y,GMRCO,GMRCORNP,GMRCAD,ORCOM) ;Receive the consult into the service
5 ;GMRCO - The internal file number of the consult from File 123
6 ;GMRCORNP - internal file number of the person receiving the request into the service
7 ;GMRCAD - date/time consult received into the service
8 ;ORCOM - Array containing comments related to receipt of the consult.
9 ;Passed as the following form :
10 ; ARRAY(1)="xxx xxx xxx",ARRAY(2)="XXX XXX",ARRAY(3)="XXX XXX xx", etc.
11 ; Comment is optional when consult is received.
12 S Y=$$RC^GMRCGUIA(GMRCO,GMRCORNP,GMRCAD,.ORCOM)
13 Q
14 ;
15DC(Y,GMRCO,GMRCORNP,GMRCAD,GMRCACTM,ORCOM) ;Discontinue or Deny a consult
16 ;GMRCO - Internal file number of consult from File 123
17 ;GMRCORNP - Provider who Discontinued or Denied consult
18 ;GMRCAD - Date/Time Consult was discontinued or denied.
19 ;GMRCACTM - If consult is 'DENIED' passed in as 'DY'; if consult is Discontinued passed in as 'DC'.
20 ;ORCOM - Array containing explanation of why consult was denied. Passed as the following form :
21 ; ARRAY(1)="xxx xxx xxx",ARRAY(2)="XXX XXX",ARRAY(3)="XXX XXX xx", etc.
22 ; Comment is a required field when consult is denied or discontinued.
23 S Y=$$DC^GMRCGUIA(GMRCO,GMRCORNP,GMRCAD,GMRCACTM,.ORCOM)
24 Q
25 ;
26FR(Y,GMRCO,GMRCSS,GMRCORNP,GMRCATTN,GMRCURGI,ORDATE,ORCOM) ;Forward consult/request to another service
27 ;GMRCO - IEN of consult from File 123
28 ;GMRCSS - Service to which consult is being forwarded
29 ;GMRCATTN - Provider whose attention consult is sent to. Can be "" or pointer to File 200
30 ;GMRCURGI - Urgency of the request
31 ;GMRCORNP - Person who is responsible for forwarding the consult
32 ;ORCOM is the comments array explaining the forwarding action
33 ; passed in as ORCOM(1)="Xxxx Xxxxx...",ORCOM(2)="Xxxx Xx Xxx...", ORCOM(3)="Xxxxx Xxx Xx...", etc.
34 S:+$G(GMRCATTN)=0 GMRCATTN=""
35 S Y=$$FR^GMRCGUIA(GMRCO,GMRCSS,GMRCORNP,GMRCATTN,GMRCURGI,.ORCOM,ORDATE)
36 Q
37 ;
38SETACTM(Y,GMRCO) ;set action menus in GUI based on service of selected consult
39 Q:+$G(GMRCO)=0
40 N ORFLG
41 S Y=0
42 D CPRS^GMRCACTM(GMRCO,1)
43 Q:'$D(ORFLG(GMRCO))
44 S Y=ORFLG(GMRCO)
45 Q
46 ;
47URG(Y,GMRCO) ;new urgency from 101.42
48 Q:+$G(GMRCO)=0
49 N GMRCURG,X,GMRCCSLT,GMRCPROC,GMRCTYPE,GMRCPROT
50 S GMRCCSLT=$O(^ORD(101,"B","GMRCOR CONSULT",0))
51 S GMRCPROC=$O(^ORD(101,"B","GMRCOR REQUEST",0))
52 S GMRCTYPE=$P(^GMR(123,+GMRCO,0),"^",17)
53 I $P(^GMR(123,+GMRCO,0),"^",18)["I" D
54 . S X=$S(GMRCTYPE=GMRCCSLT:"S.GMRCT",1:"S.GMRCR")
55 E S X="S.GMRCO"
56 S GMRCURG=""
57 F I=1:1 S GMRCURG=$O(^ORD(101.42,X,GMRCURG)) Q:GMRCURG="" D
58 .S GMRCPROT=$O(^ORD(101,"B","GMRCURGENCY - "_GMRCURG,0))
59 .S Y(I)=GMRCPROT_U_GMRCURG
60 .;S Y(I)=$O(^ORD(101.42,X,GMRCURG,0))_U_GMRCURG
61 Q
62 ;
63GETCSLT(ORY,ORIEN,SHOWADD) ; Retrieve a complete consult record
64 N ORDOC,ORREQ,I,X,SEQUENCE,ORI,ORGMRC,MEDRSLTS,ROOT
65 S MEDRSLTS=1
66 Q:+$G(ORIEN)=0
67 I '$D(^GMR(123,ORIEN)) S ORY(0)="-1^Invalid consult" Q
68 I $$PATCH^XPDUTL("GMRC*3.0*17") D
69 . D DOCLIST^GMRCGUIB(.ORGMRC,ORIEN,MEDRSLTS)
70 E D DOCLIST^GMRCGUIB(.ORGMRC,ORIEN)
71 S ORY(0)=ORGMRC(0),ORREQ=$P(ORY(0),U,14)
72 S:+$G(SHOWADD) SEQUENCE="D"
73 I ORREQ'="",$D(^VA(200,ORREQ,0)) S $P(ORY(0),U,14)=ORREQ_";"_$P(^VA(200,ORREQ,0),U,1)
74 S X=0,I=1,ORI=1
75 F S X=$O(ORGMRC(50,X)) Q:X="" D
76 . S ORDOC=$P(ORGMRC(50,X),U,1)
77 . S ROOT=U_$P($P(ORDOC,";",2),",",1)_")"
78 . Q:'$D(@ROOT@(+ORDOC))
79 . I ROOT="^TIU(8925)" D
80 . . S ORY(I)=+ORDOC_U_$$RESOLVE^TIUSRVLO(+ORDOC)
81 . . S $P(ORY(I),U,14)="1",I=I+1 ; parent treenode=1 for TIU docs
82 . . S ORY("INDX",+ORDOC,ORI)=""
83 . . I +$G(SHOWADD) D
84 . . . I +$$HASDAD^TIUSRVLI(+ORDOC) S ORI=I+1 D SETDAD^TIUSRVLI("ORY",+ORDOC,.ORI) S I=ORI+1 ; for treeview of related notes
85 . . . I +$$HASKIDS^TIUSRVLI(+ORDOC) S ORI=I+1 D SETKIDS^TIUSRVLI("ORY",+ORDOC,.ORI) S I=ORI+1 ; for treeview of related notes
86 . E I $E(ROOT,1,5)="^MCAR" D
87 . . S ORY(I)=ORGMRC(50,X)
88 . . S $P(ORY(I),U,14)="2",I=I+1 ; parent treenode=2 for med results
89 K ORY("INDX")
90 Q
91 ;
92FINDCSLT(Y,GMRCIEN) ; Return list item for the selected consult only
93 N ORPT,X0,GMRCOER,SEQ,SEQ0
94 Q:+$G(GMRCIEN)=0
95 S X0=$G(^GMR(123,GMRCIEN,0)) I 'X0 S Y="-1^Consult not found" Q
96 S ORPT=$P(X0,U,2) I '$G(ORPT) S Y="-1^Patient not found" Q
97 S GMRCOER=2,SEQ=""
98 D OER^GMRCSLM1(ORPT,"","","","",GMRCOER)
99 F S SEQ=$O(^TMP("GMRCR",$J,"CS",SEQ)) Q:SEQ=""!(SEQ?1A.E) I SEQ>0 D
100 .S SEQ0=^TMP("GMRCR",$J,"CS",SEQ,0) I $P(SEQ0,U,1)=GMRCIEN S Y=SEQ0 Q
101 K ^TMP("GMRCR",$J)
102 Q
103PROCIEN(ORY,ORDITM) ; Return pointer to file 123.3 given orderable item
104 S ORY=+$P($G(^ORD(101.43,ORDITM,0)),U,2)
105 Q
106PROCSVCS(ORY,ORDITM) ; Return a list of services for a procedure
107 N PROCIEN
108 S PROCIEN=$P($G(^ORD(101.43,ORDITM,0)),U,2)
109 D GETSVC^GMRCPR0(.ORY,PROCIEN)
110 Q
111 ;
112GETORDER(Y,GMRCO) ; Return OERR order number for consult/procedure
113 I +$G(GMRCO)=0 S Y="-1" Q
114 S Y=$$ORIFN^GMRCUTL1(GMRCO)
115 ;S Y=$P($G(^GMR(123,GMRCO,0)),U,3)
116 Q
117CANEDIT(Y,GMRCO) ; Return whether consult can be edited and resubmitted
118 S Y=$$EDRESOK^GMRCEDT2(GMRCO)
119 Q
120RESUBMIT(Y,GMRCO,OREDITED) ; Edit/Resubmit a cancelled consult/procedure request
121 N ORNODE
122 S ORNODE=$NAME(^TMP("GMRCR",$J))
123 M @ORNODE=OREDITED
124 D FILE^GMRCGUIC(GMRCO,ORNODE)
125 S Y=0
126 Q
127EDITLOAD(Y,GMRCO) ; Load a cancelled consult/procedure for editing
128 Q:+$G(GMRCO)=0
129 N ORNODE,I
130 S ORNODE=$NAME(^TMP("GMRCR",$J)),I=0
131 D SEND^GMRCGUIC(GMRCO,ORNODE)
132 S Y=ORNODE
133 Q
Note: See TracBrowser for help on using the repository browser.