source: WorldVistAEHR/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCTIU.m@ 1042

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

initial load of WorldVistAEHR

File size: 5.2 KB
Line 
1GMRCTIU ;SLC/DCM - Consults - TIU utilities ;2/26/02 11:46
2 ;;3.0;CONSULT/REQUEST TRACKING;**1,4,12,18,15,17,22,27**;DEC 27, 1997
3 ;
4 ; This routine invokes IA #2427,#2638,#2832,#3161
5 ;
6GET(GMRCO,GMRCTUFN,GMRCTUST,GMRCAUTH) ;update Consult from TIU
7 ;GMRCO=IFN from file 123
8 ;GMRCTUFN=TIU IFN
9 ;GMRCTUST=TIU status of report
10 ;GMRCAUTH=Author of Document
11 N GMRCA,GMRCSTS,GMRCDFN,GMRCAD
12 S GMRCA=$S($G(GMRCTUST)["INCOMPLETE":9,1:10),GMRCSTS=$S(GMRCA=10:2,1:9)
13 I '+$G(GMRCA) S GMRCA=99,GMRCSTS=99
14 D:+$G(GMRCA) STATUS^GMRCTIU1
15 K GMRCOM,GMRCND,GMRCORNP,GMRCORTX,GMRCSA,GMRCSTS
16 Q
17 ;
18DSPLAY(GMRCTUFN,LINECT) ;Get TIU results narrative and get it ready for display
19 ;GMRCTUFN=TIU IEN of results record
20 ;LINECT=line count for list manager
21 N ND,GMRCARR
22 D RPC^TIUSRV(.GMRCARR,GMRCTUFN)
23 S ND=0
24 F S ND=$O(@GMRCARR@(ND)) Q:ND="" S ^TMP("GMRCR",$J,"DT",LINECT,0)=@GMRCARR@(ND,0),LINECT=LINECT+1
25 ;D CLEAN^VALM10
26 K @GMRCARR,RESFL,GMRCTIUY
27 S:LINECT>1 LINECT=LINECT-1
28 Q
29ENTER(GMRCO) ; Complete a consult with TIU note
30 N XQADATA,XQA,XQAID,XQAROU,XQFLG,XQAKILL
31 D ENTER^GMRCTIUE(GMRCO)
32 Q
33 ;
34ADDEND(GMRCO) ; Make an addendum to a consult result
35 N XQADATA,XQA,XQAID,XQAROU,XQFLG,XQAKILL
36 D ADDEND^GMRCTIUE(GMRCO)
37 Q
38 ;
39SEND(DFN,OVRRIDE,CP) ;Get consult list and return in ^TMP for TIU
40 ;DFN=Patient's Internal file number from file 2
41 ;OVRRIDE=BOOLEAN flag to override user validation
42 ;CP=2 if only return entries that may have CP docs attached
43 ;
44 N GMRCI,TAB
45 Q:DFN=""!(DFN<1)
46 S TAB="",$P(TAB," ",30)=""
47 K ^TMP("GMRCR",$J,"TIU")
48 D GETCONSL(DFN,2,$G(OVRRIDE),$G(CP)) ;2=returns TIU format in ^TMP
49 Q
50 ;
51RPCLIST(GMRCY,DFN) ;Get consult list and return in GMRCY for GUI
52 N GMRCI
53 I '+$G(DFN) S GMRCY(0)=0
54 D GETCONSL(DFN,1) ;1=returns GUI format in GMRCY array
55 ; The consults will be returned from GETCONSL in the GMRCY array.
56 S GMRCY(0)=+$G(GMRCI)
57 Q
58GETCONSL(DFN,ORIGIN,OVRRIDE,GMRCCP) ;Get the patients consults
59 ;ORIGIN is whether the request is for GUI=1 or LM=2.
60 ;The logic loops through the "AD" cross-reference to find consults
61 ;The output will be formatted in GMRCY for the GUI if ORIGIN is 1.
62 ;The output will be formatted in ^TMP("GMRCR",$J,"TIU" if ORIGIN is 2.
63 ;GMRCCP = 1 = return only CP entries that can have CP doc attached
64 ;
65 N GMRCQIT,GMRC,GMRCDA,GMRCDT,GMRCEDT,GMRCYR,GMRCSP,GMRCST,GMRCSTS
66 N GMRCTIU,GMRCTIUC,GMRCSS,GMRCSVC,GMRCPROC,GMRCNOTE,Y,GMRCDAT,GMRCAU
67 ;
68 ; Aug 2000 - MA changed routine to use Parameter global to set the
69 ; number of days to look backward when getting a list of consults.
70 S GMRCYR=$$FMADD^XLFDT(DT,-$$GET^XPAR("ALL","GMRC CONSULT LIST DAYS"))
71 S GMRCYR=9999999-GMRCYR,GMRCDAT=0
72 F S GMRCDAT=$O(^GMR(123,"AD",DFN,GMRCDAT)) Q:'GMRCDAT!(GMRCDAT>GMRCYR) D
73 . S GMRCDA=0
74 . F S GMRCDA=$O(^GMR(123,"AD",DFN,GMRCDAT,GMRCDA)) Q:'GMRCDA D
75 .. S GMRC(0)=$G(^GMR(123,GMRCDA,0))
76 .. S GMRCST=$P(GMRC(0),U,12)
77 .. I $P($G(^GMR(123,GMRCDA,12)),U,5)="P" Q ;can't attach to IFC placer
78 .. I "25689"'[GMRCST Q ;only return statuses c,p,a,s,pr
79 .. S GMRCDT=+GMRC(0)
80 .. S GMRCSS=$P(GMRC(0),U,5)
81 .. I '+$G(OVRRIDE) D Q:'GMRCAU
82 ... S GMRCAU=$$VALID^GMRCAU(GMRCSS,GMRCDA)
83 ... I GMRCAU=3 S GMRCAU=0 ;exclude admin users
84 .. I '$G(GMRCCP),+$G(^GMR(123,GMRCDA,1)) Q ;no CP requests for CPRS
85 .. I $G(GMRCCP),'+$G(^GMR(123,GMRCDA,1)) Q ;only return CP requests
86 .. S GMRCTIUC=0
87 .. D GETLIST^GMRCTIUL(GMRCDA,0,1,.GMRCTIUC)
88 .. I ORIGIN=1 D BLDGMRCY Q
89 .. I ORIGIN=2 D BLDTMP Q
90 .. Q
91 . Q
92 Q
93 ;
94BLDGMRCY ;Build the GMRCY array of existing consults
95 S GMRCSTS=$P($G(^ORD(100.01,+GMRCST,0)),"^",1)
96 S GMRCSS=$P(GMRC(0),U,5),GMRCSVC=$P($G(^GMR(123.5,GMRCSS,0)),U)
97 S GMRCPROC=$P($G(^GMR(123.3,+$P(GMRC(0),U,8),0)),U)
98 S GMRCI=+$G(GMRCI)+1
99 S GMRCY(GMRCI)=GMRCDA_U_GMRCDT_U_GMRCSVC_U_GMRCPROC_U_GMRCSTS_U_+GMRCTIUC(0)
100 Q
101BLDTMP ;Build TMP global for TIU
102 S GMRCSTS=$G(^ORD(100.01,+GMRCST,.1))
103 S GMRCSP=$$ORTX^GMRCAU(GMRCDA)
104 S GMRCNOTE=$S(GMRCTIUC(0)=1:" note",1:" notes")
105 S GMRCEDT=$$FMTE^XLFDT(GMRCDT,"D")
106 S GMRCI=+$G(GMRCI)+1
107 S ^TMP("GMRCR",$J,"TIU",GMRCI,0)=$J(GMRCI,3)_"> "_$E(GMRCEDT_TAB,1,12)_" C#"_$E(GMRCDA_TAB,1,9)_$E(GMRCSP_TAB,1,21)_$E(GMRCSTS_TAB,1,4)_$E(+GMRCTIUC(0)_GMRCNOTE_TAB,1,10)
108 S ^TMP("GMRCR",$J,"TIU","B",GMRCI,GMRCDA)=""
109 Q
110ANYPENDG(DFN,USER) ; Determine if user can update any unresolved CSLTs
111 ; Input:
112 ; DFN = patient being worked on or the one to check from file 2
113 ; USER = the person to check on from file 200
114 ;
115 ; Output:
116 ; 1 = yes there are unresolved consult that could be completed
117 ; 0 = no unresolved consults that USER can update
118 ;
119 N GMRCYR,GMRCDAT,GMRCDONE,GMRCDA,GMRCST,GMRC,GMRCSS,GMRCDT,GMRCAU
120 S GMRCYR=$$FMADD^XLFDT(DT,-$$GET^XPAR("ALL","GMRC CONSULT LIST DAYS"))
121 S GMRCYR=9999999-GMRCYR,GMRCDAT=0,GMRCDONE=0
122 F S GMRCDAT=$O(^GMR(123,"AD",DFN,GMRCDAT)) Q:'GMRCDAT!(GMRCDAT>GMRCYR)!(GMRCDONE) D
123 . S GMRCDA=0
124 . F S GMRCDA=$O(^GMR(123,"AD",DFN,GMRCDAT,GMRCDA)) Q:'GMRCDA D
125 .. S GMRC(0)=$G(^GMR(123,GMRCDA,0))
126 .. S GMRCST=$P(GMRC(0),U,12)
127 .. I $P($G(^GMR(123,GMRCDA,12)),U,5)="P" Q ;can't attach to IFC placer
128 .. I +$G(^GMR(123,GMRCDA,1)) Q ;can't complete CP's from NOTES tab
129 .. I "568"'[GMRCST Q ;only return statuses p,a,s
130 .. S GMRCDT=+GMRC(0)
131 .. S GMRCSS=$P(GMRC(0),U,5)
132 .. D Q:'GMRCAU
133 ... S GMRCAU=$$VALID^GMRCAU(GMRCSS,GMRCDA)
134 ... I GMRCAU=3 S GMRCAU=0 ;exclude admin users
135 ... I GMRCAU S GMRCDONE=1
136 Q GMRCDONE
137 ;
Note: See TracBrowser for help on using the repository browser.