source: WorldVistAEHR/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCSTS.m@ 724

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

initial load of WorldVistAEHR

File size: 6.1 KB
Line 
1GMRCSTS ;SLC/DLT,JFR,MA - Group update status of consult and order; 11/25/2000
2 ;;3.0;CONSULT/REQUEST TRACKING;**8,18,21**;DEC 27, 1997
3 ; Patch 18 - Change UPDCMT to use Editor to add comment and
4 ; Added Scheduled consults to selection list.
5 ; Patch 21 - Added warning message in line tag WARNING().
6 ; This routine invokes IA #2876,3121
7 N GMRCTO,GMRCDG,GMRCSVC,GMRCSVCN,GMRCEND,GMRCSTRT,GMRCSTOP,GMRCGRP
8 N GMRCCVT,GMRCM,GMRCMT,GMRCDO,DIR,DIROUT,DIRUT,DTOUT,DUOUT
9 D GETSRV I 'GMRCDG D END Q
10 D GETDTR I GMRCEND D END Q
11 S GMRCM=$$METHOD I GMRCEND D END Q
12 S GMRCCVT=$$UPD1 I GMRCEND D END Q
13 D UPDCMT(.GMRCMT)
14 D VERIFY I GMRCEND D END Q
15 D GETENTS^GMRCSTS1(GMRCSVC,GMRCSTRT,GMRCSTOP,GMRCM)
16 S GMRCDO=$$WHATTODO I 'GMRCDO D END Q
17 D DEVICE I $G(GMRCEND) D END Q
18 I $D(IO("Q")) D QUEUE,^%ZISC,END Q
19 D PRINT^GMRCSTS1(GMRCM,GMRCCVT,GMRCSVC,.GMRCMT,GMRCSTRT,GMRCSTOP,GMRCDO)
20 D END Q
21GETSRV ;Get a service that the user is authorized to update status for
22 D ^GMRCASV Q:'GMRCDG
23 S GMRCSVC=+GMRCDG,GMRCSVCN=$P($G(^GMR(123.5,+GMRCSVC,0)),U,1)
24 I $P($G(^GMR(123.5,+GMRCDG,0)),"^",4)=DUZ Q ;user has special privileges
25 ;Check for parent service authorization
26 N AUTH,PARENT
27 I $P(^GMR(123.5,1,0),U,4)=DUZ Q
28 S (AUTH,PARENT)=0 F S PARENT=$O(^GMR(123.5,"APC",+GMRCDG,PARENT)) Q:'PARENT S:$P($G(^GMR(123.5,+PARENT,0)),U,4)=DUZ AUTH=PARENT
29 I 'AUTH D UNAUTH S GMRCDG=0 G GETSRV
30 Q
31 ;
32UNAUTH ;Unauthorized to do special update processing for service or its parent.
33 N GMRCMSG
34 W !
35 S GMRCMSG="You are not defined as the SPECIAL UPDATES INDIVIDUAL for the"
36 S GMRCMSG(1)=GMRCSVCN_" service or its parent service."
37 S GMRCDG=0
38 D EXAC^GMRCADC(.GMRCMSG)
39 Q
40 ;
41GETDTR ;Get the date range
42 ;END=# of days (T-END) for stop default limitations
43 ;GMRCSTRT=Start date/time
44 ;GMRCSTOP=Stop date/time
45 ;GMRCEND=1 if user timed out or "^"
46 S GMRCEND=0
47 N X1,X2,X,END
48 S X1=$$DT^XLFDT,X2=-30 D C^%DTC S END=X K X
49 D START Q:GMRCEND
50 D STOP Q:GMRCEND
51 Q
52 ;
53START ;Get the start date
54 N DIR,Y,ORDER,FIRST,GMRCIEN
55 S ORDER=$O(^GMR(123,"AC",0)),GMRCIEN=$O(^GMR(123,"AC",+ORDER,""))
56 I +$G(GMRCIEN) D
57 . S Y=$P($G(^GMR(123,GMRCIEN,0)),U,1)
58 . X ^DD("DD") S FIRST=$P(Y,"@",1)
59 . S DIR("B")=FIRST
60 . W !!,"The first order in Consults has an entry date of "_DIR("B"),!
61 . Q
62 S DIR(0)="D^:"_END_":AEX",DIR("A")="Update Status Start Date"
63 S DIR("?")="^D HELP^%DTC"
64 D ^DIR
65 I ($D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)!('Y)) S GMRCEND=1 Q
66 S GMRCSTRT=Y
67 Q
68 ;
69STOP ;Get the stop date
70 N DIR,Y,X
71 S DIR(0)="D^:"_END_":AEX",DIR("A")="Update Status Stop Date"
72 D ^DIR
73 I ($D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)!('Y)) S GMRCEND=1 Q
74 I Y<GMRCSTRT S GMRCSTOP=GMRCSTRT,GMRCSTRT=Y
75 E S GMRCSTOP=Y
76 Q
77 ;
78METHOD() ;Get method to determine which consults to change
79 N DIR,Y,X
80 ;S DIR(0)="SM^P:Pending;A:Active;S:Scheduled;ALL:For All"
81 ;S DIR("A")="Status(es) to search for updating"
82 S DIR("A",1)=""
83 S DIR("A",2)=""
84 S DIR("A",3)=" 1 = Pending"
85 S DIR("A",4)=" 2 = Active"
86 S DIR("A",5)=" 3 = Scheduled"
87 S DIR("A",6)=" 4 = All"
88 S DIR("A",7)=""
89 S DIR("A",8)=" Enter any combination of numbers separated"
90 S DIR("A")=" by a comma or hyphen"
91 S DIR(0)="LO^1:4"
92 D ^DIR
93 I ($D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)) S GMRCEND=1
94 Q Y
95 S DIR(0)="SM^S:Order Status of Pending or Active;R:Result Activity"
96 S DIR("A")="Method to find Consults to Update"
97 D ^DIR
98 I ($D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)) S GMRCEND=1 Q Y
99 Q Y
100 ;
101VERIFY ;Verify the criteria is correct
102 W !
103 D UPDCRIT^GMRCSTS1(GMRCCVT,GMRCM,GMRCSVC,.GMRCMT,GMRCSTRT,GMRCSTOP)
104 N DIR
105 S DIR(0)="Y",DIR("A")="Is this correct",DIR("B")="NO"
106 D ^DIR I ($D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)!('Y)) S GMRCEND=1 Q
107 Q
108UPD1() ;Determine update status
109 N DIR,X,Y
110 W !!,"If orders in the date range still have the selected status, this option"
111 W !,"will change their status in consults, and update the order."
112 W !!,"You may change the status to COMPLETE or DISCONTINUED."
113 W !
114 S DIR(0)="SAM^D:Discontinued;C:Complete"
115 S DIR("A")="Change their status to: "
116 D ^DIR I ($D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)) S GMRCEND=1 Q Y
117 Q $S(Y="D":"1^DC",1:"2^C")
118 ;
119DEVICE ; device for printout of entries to group update
120 N %ZIS,POP
121 W !!,"The device selected will print a list of entries from file 123 that will be"
122 W !,"updated to ",$S(+GMRCCVT=1:"DISCONTINUED",1:"COMPLETE"),"."
123 W !!,"If you choose to update records, the update of the consult entries will take"
124 W !,"place upon completion of the report."
125 W !!,"It is highly advised that a printer be selected!"
126RETRY S %ZIS="QM",%ZIS("A")="Select device for report: ",%ZIS("B")=""
127 D ^%ZIS
128 I POP S GMRCEND=1 Q
129 I $E(IOST,1,2)="C-" D G:Y<1 RETRY
130 . W !!,$C(7),"You have not chosen a printer! If you do not choose a printer there will",!,"be no record of the entries that were updated."
131 . N DIR,DIROUT,DIRUT,DTOUT,DUOUT
132 . S DIR(0)="Y",DIR("A")="Are you sure you want to use this device"
133 . S DIR("B")="NO" D ^DIR I $D(DIRUT) S GMRCEND=1
134 Q
135QUEUE ; send task for print and update
136 I GMRCDO=2,'$$WARNING D ^%ZISC,END Q ; Killed report
137 N ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSAVE,ZTSK
138 S ZTRTN="PRTTSK^GMRCSTS1",ZTDESC="UPDATE OF RECORDS FILE 123"
139 S ZTIO=ION
140 S ZTSAVE("^TMP(""GMRCLS"",$J,")="",ZTSAVE("GMRC*")=""
141 D ^%ZTLOAD I $G(ZTSK) W !,"Task # ",ZTSK
142 I '$G(ZTSK) W !,"Unable to queue report! Try again later."
143 Q
144UPDCMT(COMMENT) ; get comment to stuff in consult activity
145 W !
146 N DWPK,DWLW,DIC,DIWEPSE,INDEX
147 W !,"Enter the Comment to be applied to all selected Consults"
148 S DIC="^TMP(""GMRCTMP"","_$J_",1,",DWLW=80,DWPK=1,DIWEPSE=1
149 D EN^DIWE
150 S INDEX=0
151 F S INDEX=$O(^TMP("GMRCTMP",$J,1,INDEX)) Q:'INDEX D
152 . S COMMENT(INDEX,0)=^TMP("GMRCTMP",$J,1,INDEX,0)
153 K ^TMP("GMRCTMP",$J)
154 Q
155WHATTODO() ;how to handle the update
156 N DIR
157 S DIR(0)="SO^1:Print report only;2:Print report & update records;3:Quit"
158 S DIR("A")="Choose the method to handle the report"
159 D ^DIR I $D(DIRUT)!(Y=3) Q 0
160 Q +Y
161WARNING() ; If REPORT/UPDATE is being task issue warning message.
162 N DIR,DIROUT,DIRUT,DTOUT,DUOUT
163 I $D(IO("Q")) D
164 . W !,"WARNING - Records will automatically be updated since the"
165 . W !,"report is being tasked.",!
166 S DIR("B")="NO",DIR(0)="Y",DIR("A")="Do you wish to continue??"
167 D ^DIR I $D(DIRUT) S Y=0
168 Q +Y
169END K ^TMP("GMRCLS",$J) Q
Note: See TracBrowser for help on using the repository browser.