source: WorldVistAEHR/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCSTS1.m@ 660

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

initial load of WorldVistAEHR
File size: 6.1 KB
Line 
1GMRCSTS1 ;SLC/JFR,MA - GROUP UPDATE OF CONSULTS cont'd ;4/18/01 10:31
2 ;;3.0;CONSULT/REQUEST TRACKING;**8,18,21,50**;DEC 27, 1997;Build 8
3 ; Patch 18 modified PRTTSK to stop for acknowledgement between
4 ; printing the report and continuing with the group update.
5 ; Patch 21 moved the ^%ZISC up a few lines to correct a problem
6 ; of menu going to the printer
7 ; This routine invokes IA #2638
8PROCESS(GMRCCVT,GMRCMT) ;Update consult status by service and date range
9 N GMRCO,GMRCSTS,GMRCTRLC,GMRCORNP,GMRCDEV,GMRCFF,GMRCAD,ORIFN
10 N GMRCOM1,ORIFN
11 Q:'GMRCCVT
12 I '$D(^TMP("GMRCLS",$J)) Q ;no entries to update
13 S GMRCIEN=0 F S GMRCIEN=$O(^TMP("GMRCLS",$J,GMRCIEN)) Q:'GMRCIEN D
14 . Q:'$L($G(^GMR(123,GMRCIEN,0)))
15 . D AUDIT(GMRCIEN,+GMRCCVT,.GMRCMT)
16 . D STSUPD(GMRCIEN,+GMRCCVT)
17 . D CPRSUPDT(GMRCIEN,+GMRCCVT)
18 Q
19PRINT(GMRCM,GMRCCVT,GMRCSVC,GMRCMT,GMRCSTRT,GMRCSTOP,GMRCDO) ;untasked print of records to update
20PRTTSK ; print the report then start the processing
21 ; GMRCM= status of records to find A:active, P:pending, B:Both
22 ; GMRCCVT= status to update records with 1:dc, 2:complete
23 ; GMRCSVC= IEN from file 123.5
24 ; GMRCMT= array (passed by reference) of comment to stuff in records
25 ; GMRCSTRT= first entry date to find/update
26 ; GMRCSTOP= last entry date to find/update
27 ; GMRCDO= 1:print only, 2:print and update records
28 ; GMRCSTAT= Status of consult for the report (P,A,S)
29 N GMRCIEN,GMRCDFN,GMRCPG,GMRCEND,GMRCSTAT
30 S GMRCIEN=0
31 U IO
32 D HDR(1) S GMRCPG=2
33 I '$D(^TMP("GMRCLS",$J)) D D END
34 . W !,"No records found meeting search criteria"
35 F S GMRCIEN=$O(^TMP("GMRCLS",$J,GMRCIEN)) Q:'GMRCIEN!($G(GMRCEND)) D
36 . I $Y>(IOSL-5) D HDR(GMRCPG) Q:$G(GMRCEND) S GMRCPG=GMRCPG+1
37 . Q:'$G(^GMR(123,GMRCIEN,0))
38 . I $P(^GMR(123,GMRCIEN,0),U,12)=1!($P(^(0),U,12)=2) Q
39 . W !,GMRCIEN,?8,$$FMTE^XLFDT(+^GMR(123,GMRCIEN,0))
40 . W ?29,$E($$GET1^DIQ(2,$P(^GMR(123,GMRCIEN,0),U,2),.01),1,26)
41 . W ?56,$$GET1^DIQ(2,$P(^GMR(123,GMRCIEN,0),U,2),.09)
42 . S GMRCSTAT=+^TMP("GMRCLS",$J,GMRCIEN)
43 . W ?70,$S(GMRCSTAT=5:"p",GMRCSTAT=6:"a",GMRCSTAT=8:"s",1:"?")
44 . W " to ",$S(+GMRCCVT=1:"dc",1:"c")
45 D ^%ZISC
46 I GMRCDO=2,'$D(ZTQUEUED) D ; Not task
47 . S DIR(0)="S^Y:To Update;N:To Quit without Updating"
48 . S DIR("A")="Enter update status "
49 . I ($D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)) Q
50 . D ^DIR
51 . I Y="Y" D PROCESS(+GMRCCVT,.GMRCMT)
52 I GMRCDO=2,$D(ZTQUEUED) D PROCESS(+GMRCCVT,.GMRCMT) ; Tasked
53END K ^TMP("GMRCLS",$J)
54 Q
55 ;
56HDR(PAGE) ; print the header for the report
57 I PAGE'=1,$E(IOST,1,2)["C-" N Y D I '+Y S GMRCEND=1 Q
58 . N DIR S DIR(0)="E" D ^DIR
59 W @IOF
60 W !,"Group status update of consults in file 123",?70,"Page: ",PAGE W:PAGE'=1 !
61 I PAGE=1 W !,?49,"Printed: ",$$FMTE^XLFDT($$NOW^XLFDT)
62 I PAGE=1 D UPDCRIT(GMRCCVT,GMRCM,GMRCSVC,.GMRCMT,GMRCSTRT,GMRCSTOP)
63 W !,"Consult",?70,"Status"
64 W !,"Number Requested Patient SSN Change"
65 W !,$$REPEAT^XLFSTR("-",79)
66 Q
67GETENTS(SERV,STRDT,STPDT,SRCH) ;loop "AE" x-ref and dump into ^TMP
68 N IDT,IEN,STOPI,STRTI,STS,INDEX
69 W !!,"Searching database for entries matching search criteria",!
70 S STOPI=(9999999-STPDT)-1,STRTI=(9999999-STRDT)
71 F INDEX=1:1 Q:$P(SRCH,",",INDEX)="" D
72 . I $P(SRCH,",",INDEX)=+4 S SRCH="1,2,3,"
73 ; Convert SRCH from 1,2,3 to 5,6,8 (pending,active,scheduled)
74 F INDEX=1:1 Q:$P(SRCH,",",INDEX)="" D
75 . I $P(SRCH,",",INDEX)=+1 S STS=+5 D GETDATA
76 . I $P(SRCH,",",INDEX)=+2 S STS=+6 D GETDATA
77 . I $P(SRCH,",",INDEX)=+3 S STS=+8 D GETDATA
78GETDATA ; Write ^GMR(123,IEN,0) to TMP
79 S IDT=STOPI
80 F S IDT=$O(^GMR(123,"AE",SERV,+STS,IDT)) Q:'IDT!(IDT>STRTI) D
81 . S IEN=0 F S IEN=$O(^GMR(123,"AE",SERV,+STS,IDT,IEN)) Q:'IEN D
82 .. S ^TMP("GMRCLS",$J,IEN)=+STS_U_+^GMR(123,IEN,0)
83 .. W "."
84 Q
85AUDIT(GMRCO,UPDSTS,GMRCOM) ;Update the processing activity of the consult
86 ;GMRCO= IEN from file 123
87 ;UPDSTS= 1 for DC ; 2 for COMPLETE
88 N DA,DIE,GMRCA,GMRCDT,GMRCSTS
89 S GMRCDT=$$NOW^XLFDT,GMRCA=$S(UPDSTS=1:6,1:10)
90 S GMRCSTS=$P(^GMR(123,GMRCO,0),U,12)
91 S:'$D(^GMR(123,+GMRCO,40,0)) ^(0)="^123.02DA^^"
92 S DA=$S($P(^GMR(123,+GMRCO,40,0),"^",3):$P(^(0),"^",3)+1,1:1),$P(^GMR(123,GMRCO,40,0),"^",3,4)=DA_"^"_DA
93 S DIE="^GMR(123,"_+GMRCO_",40,",DA(1)=+GMRCO
94 S DR=".01////^S X=GMRCDT;1////^S X=GMRCA;2////^S X=GMRCDT;3////^S X=DUZ;4////^S X=DUZ"
95 D ^DIE
96 S ^GMR(123,+GMRCO,40,DA,1,0)="^^1^1^"_GMRCDT_"^"
97 I $D(GMRCOM) D
98 . M ^GMR(123,+GMRCO,40,DA,1)=GMRCOM
99 I '$D(GMRCOM) D
100 . N COMMENT
101 . S COMMENT="Status updated from "
102 . S COMMENT=COMMENT_$P(^ORD(100.01,+GMRCSTS,0),"^",1)
103 . S COMMENT=COMMENT_" to "_$S(+UPDSTS=2:"COMPLETE",1:"DISCONTINUED")
104 . S COMMENT=COMMENT_" during group status update process."
105 . S ^GMR(123,+GMRCO,40,DA,1,1,0)=COMMENT
106 ;Check for IFC and update accordingly
107 I $D(^GMR(123,+GMRCO,12)),$D(^(40,DA)) D TRIGR^GMRCIEVT(GMRCO,DA)
108 K DIE,GMRCA,GMRCDT
109 Q
110STSUPD(GMRCO,UPDSTS) ;change status of consult to COMPLETE or DC
111 ;GMRCO= IEN from file 123
112 ;UPDSTS= 1 for DC ; 2 for COMPLETE
113 N DIE,DA,DR,GMRCLST,X
114 S GMRCLST=$S(UPDSTS=1:$O(^GMR(123.1,"B","DISCONTINUED",0)),UPDSTS=2:$O(^GMR(123.1,"B","COMPLETE/UPDATE",0)),1:99)
115 S DIE="^GMR(123,",DA=GMRCO
116 S DR="8////^S X=+UPDSTS;9////"_GMRCLST
117 D ^DIE
118 Q
119CPRSUPDT(GMRCO,UPDSTS) ;Update CPRS order with new status
120 ;GMRCO= IEN from file 123
121 ;UPDSTS= status to update CPRS with
122 N GMRCDFN,CTRLCODE
123 S GMRCDFN=$P(^GMR(123,GMRCO,0),"^",2)
124 S CTRLCODE=$S(UPDSTS=1:"OD",1:"RE")
125 ; send HL7 message to CPRS to update order status
126 D EN^GMRCHL7(GMRCDFN,+GMRCO,"","",CTRLCODE,DUZ,"","",1)
127 Q
128UPDCRIT(UPD,STS,SVC,CMT,START,STOP) ;print update criteria on page 1
129 N INDEX,GMRCSTS
130 F INDEX=1:1 Q:$P(STS,",",INDEX)="" D
131 . I STS[+4 S GMRCSTS="Active, Pending, and Scheduled" Q
132 . I $P(STS,",",INDEX)=+1 S $P(GMRCSTS,",",INDEX)="Pending"
133 . I $P(STS,",",INDEX)=+2 S $P(GMRCSTS,",",INDEX)="Active"
134 . I $P(STS,",",INDEX)=+3 S $P(GMRCSTS,",",INDEX)="Scheduled"
135 W !,"Records will be updated for:"
136 W !,$$REPEAT^XLFSTR("-",78)
137 W !," Service: "_$$GET1^DIQ(123.5,SVC,.01)
138 W !," Beginning: "_$$FMTE^XLFDT(START)
139 W !," Ending: "_$$FMTE^XLFDT(STOP)
140 W !," Update: "_GMRCSTS_" "_" Consults"
141 W !," To: "_$S(+UPD=2:"COMPLETE",1:"DISCONTINUED")
142 I $D(CMT) W !," Update Comment:" D
143 . N I S I=0 F S I=$O(CMT(I)) Q:'I D
144 .. W !,CMT(I,0)
145 W !,$$REPEAT^XLFSTR("-",78),!
146 Q
Note: See TracBrowser for help on using the repository browser.