source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORQQCN2.m@ 1240

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

initial load of WorldVistAEHR
File size: 6.7 KB
Line 
1ORQQCN2 ; slc/REV - Functions for GUI consult actions ; 02 April 2003 4:05 PM
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,125,131,149,215,242**;Dec 17, 1997;Build 6
3 ;
4 ; DBIA 2426 SERV1^GMRCASV ^TMP("GMRCSLIST,$J)
5 ;
6CMT(ORERR,ORIEN,ORCOM,ORALRT,ORALTO,ORDATE) ;Add comment to existing consult without changing status
7 ;ORIEN - IEN of consult from File 123
8 ;ORERR - return array for results/errors
9 ;ORCOM is the comments array to be added
10 ; passed in as ORCOM(1)="Xxxx Xxxxx...",ORCOM(2)="Xxxx Xx Xxx...", ORCOM(3)="Xxxxx Xxx Xx...", etc.
11 ;ORALRT - should alerts be sent to anyone?
12 ;ORALTO - array of alert recipient IENs
13 N ORAD,ORDUZ,ORNP,X
14 S ORERR=0,ORAD=$S($D(ORDATE):ORDATE,1:$$NOW^XLFDT),ORNP=""
15 I '$D(ORCOM) S ORERR="1^Comments required - no action taken" Q
16 I '$D(^GMR(123,ORIEN)) S ORERR="1^No such consult" Q
17 I $G(ORALRT)=1 D
18 .F I=1:1 S X=$P(ORALTO,";",I) Q:X="" S ORDUZ(X)=""
19 D CMT^GMRCGUIB(ORIEN,.ORCOM,.ORDUZ,ORAD,DUZ)
20 Q
21 ;
22SCH(ORERR,ORIEN,ORNP,ORDATE,ORALRT,ORALTO,ORCOM) ;Schedule consult and change status
23 ;ORERR - return array for results/errors
24 ;ORIEN - IEN of consult from File 123
25 ;ORNP - Provider who Scheduled consult
26 ;ORDATE - Date/Time Consult was scheduled.
27 ;ORALRT - should alerts be sent to anyone?
28 ;ORALTO - array of alert recipient IENs
29 ;ORCOM is the comments array to be added
30 ; passed in as ORCOM(1)="Xxxx Xxxxx...",ORCOM(2)="Xxxx Xx Xxx...", ORCOM(3)="Xxxxx Xxx Xx...", etc.
31 N ORAD,ORDUZ,X
32 S ORERR=0,ORAD=$S($D(ORDATE):ORDATE,1:$$NOW^XLFDT)
33 S:+$G(ORNP)=0 ORNP=DUZ
34 I '$D(^GMR(123,ORIEN)) S ORERR="1^No such consult" Q
35 I $G(ORALRT)=1 D
36 .F I=1:1 S X=$P(ORALTO,";",I) Q:X="" S ORDUZ(X)=""
37 S ORERR=$$SCH^GMRCGUIB(ORIEN,ORNP,ORAD,.ORDUZ,.ORCOM)
38 Q
39 ;
40SVCTREE(Y,PURPOSE) ;Returns list of consult service for current
41 ; context, screening for inactive, groupers, and tracking
42 ; PURPOSE: Display=0, Forward=1, Order=1
43 N GMRCTO,GMRCDG,GMRCSVC,GMRCOI
44 S GMRCTO=PURPOSE,GMRCDG=1
45 D SERV1^GMRCASV
46 S GMRCSVC=0
47 I '$D(^TMP("GMRCSLIST",$J)) S Y(1)="-1^No services found" Q ;DBIA 2426
48 F I=1:1 S GMRCSVC=$O(^TMP("GMRCSLIST",$J,GMRCSVC)) Q:+GMRCSVC=0 D
49 . S Y(I)=^TMP("GMRCSLIST",$J,GMRCSVC)
50 . S GMRCOI=$O(^ORD(101.43,"ID",$P(Y(I),U,1)_";99CON",0))
51 . S Y(I)=Y(I)_U_GMRCOI
52 Q
53 ;
54SVCSYN(ORROOT,ORSTRT,ORWHY,ORSYN,ORIEN) ;;return CSLT services for GUI
55 ;Input:
56 ; ORROOT - passed in as the array to return results in
57 ; ORSTRT- service to begin building from
58 ; ORWHY - 0 for display, 1 for forwarding or ordering
59 ; ORSYN - Boolean: 1=return synonyms, 0=do not
60 ; ORIEN - Consult IEN (file 123) (OPTIONAL)
61 ;Output: Array formatted as follows-
62 ; svc ien^svc name or syn^parent^has children^svc usage^orderable item
63 N ORSVC,I,X,OI
64 S:+$G(ORSTRT)=0 ORSTRT=1
65 S:$G(ORWHY)="" ORWHY=1
66 S:$G(ORSYN)="" ORSYN=1
67 S ORROOT=$NA(^TMP("ORCSLT",$J))
68 D GUI^GMRCASV1(ORROOT,ORSTRT,ORWHY,ORSYN,$G(ORIEN))
69 S ORSVC=0
70 I '$D(@ORROOT) S @ORROOT@(1)="-1^No services found" Q
71 F I=1:1 S ORSVC=$O(@ORROOT@(ORSVC)) Q:+ORSVC=0 D
72 . S X=@ORROOT@(ORSVC)
73 . S OI=$O(^ORD(101.43,"ID",$P(X,U,1)_";99CON",0))
74 . I +OI>0 S @ORROOT@(ORSVC)=X_U_OI
75 Q
76STATUS(Y) ; Returns a list of statuses currently in use
77 ;
78 N GMRCORST
79 S GMRCORST=0,Y(999)="999^OTHER^"
80 F S GMRCORST=$O(^ORD(100.01,GMRCORST)) Q:'+GMRCORST D
81 . I '$D(^GMR(123.1,"AC",GMRCORST)) S Y(999)=Y(999)_GMRCORST_"," Q
82 . Q:$$SCREEN^XTID(100.01,,GMRCORST_",") ;inactive VUID
83 . S Y(GMRCORST)=GMRCORST_U_$P(^ORD(100.01,GMRCORST,0),U,1)
84 Q
85 ;
86MEDRSLT(ORY,GMRCO) ;Returns Medicine results plus TIU results
87 S ORY=$NA(^TMP("ORRSLT",$J))
88 D RT^GMRCGUIA(GMRCO,ORY)
89 Q
90 ;
91SHOW513(ORY,GMRCO) ;CONSULTS SF513 DISPLAY IN GUI
92 D GUI^GMRCP5(.ORY,GMRCO)
93 Q
94PRT513(Y,GMRCO,GMRCCHT,GMRCDEV) ; Print SF513 to VistA device from GUI
95 N ORSTATUS
96 D EN^GMRCP5(GMRCO,GMRCCHT,GMRCDEV,.ORSTATUS)
97 S Y=ORSTATUS
98 Q
99WPRT513(ORY,GMRCO,GMRCCHT) ;Print SF513 to Windows device from GUI
100 N ZTQUEUED,ORHFS,ORSUB,ORIO,ORSTATUS,ROOT,ORHANDLE
101 N IOM,IOSL,IOST,IOF,IOT,IOS
102 S (ORSUB,ROOT)="ORDATA",ORIO="OR WINDOWS HFS",ORHANDLE="ORQQCN2"
103 S ORY=$NA(^TMP(ORSUB,$J,1))
104 S ORHFS=$$HFS^ORWRP()
105 D HFSOPEN^ORWRP(ORHANDLE,ORHFS,"W")
106 I POP D Q
107 . I $D(ROOT) D SETITEM^ORWRP(.ROOT,"ERROR: Unable to open HFS file for SF513 print")
108 D IOVAR^ORWRP(.ORIO,,,"P-WINHFS80")
109 N $ETRAP,$ESTACK
110 S $ETRAP="D ERR^ORWRP Q"
111 U IO
112 D PRNT^GMRCP5A(GMRCO,0,0,GMRCCHT,0)
113 D HFSCLOSE^ORWRP(ORHANDLE,ORHFS)
114 Q
115SIGFIND(Y,ORIEN,ORFL,ORCOM,ORALRT,ORALTO,ORDATE) ;Significant findings
116 S Y=$$SFILE^GMRCGUIB(ORIEN,4,ORFL,"",DUZ,.ORCOM,ORALRT,ORALTO,ORDATE) ; "4"=SIG FIND ACTION
117 Q
118ADMCOMPL(Y,ORIEN,ORFL,ORCOM,ORRESP,ORALRT,ORALTO,ORDATE) ; Admin users
119 ; Administrative complete action
120 S Y=$$SFILE^GMRCGUIB(ORIEN,10,ORFL,ORRESP,DUZ,.ORCOM,ORALRT,ORALTO,ORDATE) ; "10"=Admin Complete
121 Q
122SVCLIST(ORY,FROM,DIR) ; Return a set of consult services in long list format
123 ; .ORY=returned list, FROM=text to $O from, DIR=$O direction,
124 N I,IEN,CNT,Y,ORTMP,ORSVC,ORSTR
125 S I=0,CNT=44,ORSVC=""
126 D SVCTREE^ORQQCN2(.Y,1)
127 F I=1:1 S ORSVC=$P($G(Y(I)),U,2) Q:ORSVC="" D
128 . S ORTMP(ORSVC)=Y(I)
129 F I=1:1 Q:I=CNT S FROM=$O(ORTMP(FROM),DIR) Q:FROM="" D
130 . S ORSTR=ORTMP(FROM)
131 . S ORY(I)=ORSTR
132 Q
133GETCTXT(Y,ORUSER) ; Returns current view context for user
134 S Y=$$GET^XPAR("ALL","ORCH CONTEXT CONSULTS",1)
135 Q
136SAVECTXT(Y,ORCTXT) ; Save new view preferences for user
137 N TMP
138 S TMP=$$GET^XPAR(DUZ_";VA(200,","ORCH CONTEXT CONSULTS",1)
139 I TMP'="" D Q
140 . D CHG^XPAR(DUZ_";VA(200,","ORCH CONTEXT CONSULTS",1,ORCTXT)
141 D ADD^XPAR(DUZ_";VA(200,","ORCH CONTEXT CONSULTS",1,ORCTXT)
142 Q
143 ;
144DEFRFREQ(ORY,ORSVC,ORDFN,RESOLVE) ;Return default reason for request for service
145 ; ORSVC=pointer to file 123.5
146 ; ORDFN=patient, if RESOLVE=1
147 ; RESOLVE=1 to resolve boilerplate, 0 to not resolve
148 Q:+$G(ORSVC)=0
149 I +RESOLVE,(+$G(ORDFN)=0) Q
150 S ORY=$NA(^TMP("ORREQ",$J))
151 S:$G(RESOLVE)="" RESOLVE=0
152 D GETDEF^GMRCDRFR(.ORY,ORSVC,ORDFN,RESOLVE)
153 K @ORY@(0)
154 Q
155EDITDRFR(ORY,ORSVC) ; Allow editing of reason for request?
156 S ORY=$$REAF^GMRCDRFR(ORSVC)
157 Q
158SVCIEN(ORY,ORIEN) ;Given orderable item file entry, return IEN in 123.5, OR -1 IF INACTIVE IN 101.43
159 N X1
160 I '$D(^ORD(101.43,ORIEN)) S ORY=-1 Q
161 S X1=$G(^ORD(101.43,ORIEN,.1))
162 I +X1,+X1<$$NOW^XLFDT S ORY=-1 Q
163 S ORY=$P($$USID^ORWDXC(ORIEN),U,4)
164 Q
165PROVDX(ORY,ORIEN) ;Return provisional dx prompting info for service
166 S ORY=$$PROVDX^GMRCUTL1(ORIEN)
167 Q
168PREREQ(ORY,ORSVC,ORDFN) ;Returns prequisites for ordering
169 Q:(+$G(ORSVC)=0)!(+$G(ORDFN)=0)
170 S ORY=$NA(^TMP("ORPREREQ",$J))
171 D PREREQ^GMRCUTL1(.ORY,ORSVC,ORDFN,0) ;0=RESOLVE OBJECTS
172 K @ORY@(0)
173 Q
174UNRSLVD(ORY,ORDFN) ;Returns true if unresolved consults for user/pt
175 ;S ORY=0
176 ;Q:+$$GET^XPAR("ALL","ORWOR SHOW CONSULTS",1,"I")=0
177 ;S ORY=+$$ANYPENDG^GMRCTIU(ORDFN,DUZ) ;DBIA #3473
178 ;Q
179 S $P(ORY,U,1)=+$$ANYPENDG^GMRCTIU(ORDFN,DUZ) ;DBIA #3473
180 S $P(ORY,U,2)=+$$GET^XPAR("ALL","ORWOR SHOW CONSULTS",1,"I")
181 Q
Note: See TracBrowser for help on using the repository browser.