source: FOIAVistA/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCP50A.m@ 1540

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

initial load of FOIAVistA 6/30/08 version
File size: 8.2 KB
Line 
1GMRCP50A ;ISP/TDP - PRE INSTALL ROUTINE FOR GMRC*3*50 ; 11/15/2006
2 ;;3.0;CONSULT/REQUEST TRACKING;**50**;DEC 27, 1997;Build 8
3 Q
4MSG ;Send Mailman message to installer
5 N GMRC0,GMRCACT,GMRCADT,GMRCC,GMRCCIEN,GMRCCNT,GMRCCPRS,GMRCDFN,GMRCDT
6 N GMRCFDT,GMRCID,GMRCIEN,GMRCIFC,GMRCMSG,GMRCPARM,GMRCPG,GMRCPRV,GMRCSPC
7 N GMRCSVC,GMRCTPG,GMRCTXT,GMRCWHO,XMDUZ,XMERR,XMSUB,XMTEXT,XMY,Y
8 S GMRCTTL=GMRCTTL-GMRCITL
9 I DUZ="" N DUZ S DUZ=.5
10 S XMDUZ=DUZ,XMTEXT="GMRCTXT"
11 S GMRCPARM("FROM")="PATCH GMRC*3.0*50 PRE-INIT"
12 S XMY(DUZ)=""
13 S GMRCDFN=""
14 F GMRCIFC="GMRCP50","GMRCP50 IFC" D
15 . S GMRCPG=0
16 . I GMRCIFC="GMRCP50" S GMRCTPG=GMRCTTL/500 I GMRCTPG#1 S GMRCTPG=$P(GMRCTPG,".")+1
17 . I GMRCIFC="GMRCP50 IFC" S GMRCTPG=GMRCITL/500 I GMRCTPG#1 S GMRCTPG=$P(GMRCTPG,".")+1
18 . F GMRCPG=1:1:GMRCTPG D
19 .. K GMRCTXT
20 .. S GMRCC=0
21 .. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="This message ("_GMRCPG_" of "_GMRCTPG_") has been sent by patch GMRC*3.0*50 at the"
22 .. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="completion of the pre-init routine."
23 .. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "
24 .. I GMRCIFC="GMRCP50" D
25 ... S XMSUB="SIGNIFICANT FINDINGS VALUES ARE INVALID (MSG "_GMRCPG_" of "_GMRCTPG_")"
26 ... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="This message was sent because Consult records were found which contained an"
27 ... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="Ampersand as the Significant Finding. Since these can not be corrected"
28 ... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="automatically, this message was created to assist in a manual correction of"
29 ... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="this data. We are hopeful that the following data will contain enough"
30 ... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="information to allow your site to make the corrections, or at least give you"
31 ... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="the information needed to research the specific consult and determine what"
32 ... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="the Significant Finding should have been. It is important to understand the"
33 ... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="comments from the Significant Finding are fine and the only problem"
34 ... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="needing correction is the Significant Finding value itself (Yes/No/Unknown)."
35 ... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="Per guidance from HIMSS, it is preferable that an audit trail exist for this"
36 ... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="fix. A disclaimer should be added, if possible. To correct the"
37 ... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="Significant Finding, you can use the Action, Consult Tracking menu on the"
38 ... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="Consults tab of CPRS GUI. The person making this change will need the"
39 ... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="appropriate update authority for the Consult Services involved. It should"
40 ... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="also be noted the significant finding will display as ""Unknown"" despite"
41 ... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="the ampersand (""&"") stored in the data file."
42 .. I GMRCIFC="GMRCP50 IFC" D
43 ... S XMSUB="IFC SIGNIFICANT FINDINGS VALUES ARE INVALID (MSG "_GMRCPG_" of "_GMRCTPG_")"
44 ... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="This message was sent because Inter-Facility Consult records were found"
45 ... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="which contained an Ampersand as the Significant Finding. Since these can"
46 ... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="not be corrected by the requesting (sending) site, this message was created"
47 ... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="to alert you of these entries. The Consulting (receiving) site(s) will need"
48 ... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="to correct these entries and should receive a similar message when they"
49 ... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="install this patch. You can use this list as a record of Inter-Facility"
50 ... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="Consults needing to be corrected by the Consulting (receiving) site(s)."
51 .. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "
52 .. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="PATIENT IDENTIFIER"
53 .. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" CONSULT DATE(IEN)"
54 .. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" TO SERVICE STATUS"
55 .. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" ACTIVITY ACTIVITY DATE RESPONSIBLE PERSON"
56 .. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" ACTIVITY COMMENTS"
57 .. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="==============================================================================="
58 .. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "
59 .. S GMRCSPC=" "
60 .. S GMRCCNT=0
61 .. F S GMRCDFN=$O(^TMP(GMRCIFC,$J,GMRCDFN)) Q:GMRCDFN="" D Q:GMRCCNT>499
62 ... S GMRCID=$S(NMFLG:GMRCDFN,1:$G(^TMP(GMRCIFC,$J,GMRCDFN,0)))
63 ... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=GMRCID
64 ... S GMRCDT=0
65 ... F S GMRCDT=$O(^TMP(GMRCIFC,$J,GMRCDFN,GMRCDT)) Q:GMRCDT="" D
66 .... S GMRCIEN=0
67 .... F S GMRCIEN=$O(^TMP(GMRCIFC,$J,GMRCDFN,GMRCDT,GMRCIEN)) Q:GMRCIEN="" D
68 ..... S GMRCCIEN=0
69 ..... S GMRC0=$G(^TMP(GMRCIFC,$J,GMRCDFN,GMRCDT,GMRCIEN,0))
70 ..... ;S GMRCIEN=$P(GMRC0,U,1)
71 ..... S Y=GMRCDT
72 ..... D DD^%DT
73 ..... I Y=-1 S Y="DATE ERROR"
74 ..... S GMRCFDT=Y
75 ..... S GMRCFDT=$E(GMRCFDT_" ("_GMRCIEN_")"_GMRCSPC,1,33)
76 ..... S GMRCSVC=$E($P(GMRC0,U,2)_GMRCSPC,1,60)_" "
77 ..... S GMRCCPRS=$E($P(GMRC0,U,3)_GMRCSPC,1,15)
78 ..... S GMRCACT=$E($P(GMRC0,U,4)_GMRCSPC,1,20)
79 ..... S GMRCADT=$P(GMRC0,U,5)
80 ..... S Y=0
81 ..... I GMRCADT S Y=GMRCADT D DD^%DT I Y=-1 S Y="DATE ERROR"
82 ..... I 'GMRCADT S Y="ACTIVITY DATE UNK"
83 ..... S GMRCADT=$E(Y_GMRCSPC,1,23)
84 ..... S GMRCWHO=$E($P(GMRC0,U,6)_GMRCSPC,1,32)
85 ..... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "_GMRCFDT
86 ..... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "_GMRCSVC_GMRCCPRS
87 ..... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "_GMRCACT_GMRCADT_GMRCWHO
88 ..... F S GMRCCIEN=$O(^TMP(GMRCIFC,$J,GMRCDFN,GMRCDT,GMRCIEN,GMRCCIEN)) Q:GMRCCIEN="" D
89 ...... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "_$G(^TMP(GMRCIFC,$J,GMRCDFN,GMRCDT,GMRCIEN,GMRCCIEN))
90 ..... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "
91 ..... S GMRCCNT=GMRCCNT+1
92 .. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "
93 .. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "
94 .. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="Total records in this message: "_GMRCCNT
95 .. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="Total records containing a Significant Finding of an ampersand: "_$S(GMRCIFC="GMRCP50":GMRCTTL,1:GMRCITL)
96 .. D SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY,.GMRCPARM,"","")
97 .. S GMRCMSG(1)=" "
98 .. S GMRCMSG(2)="******************************************************************************"
99 .. I GMRCIFC="GMRCP50" D
100 ... S GMRCMSG(3)="** Message ("_$S($L(GMRCPG)=1:$J("0"_GMRCPG,2),1:GMRCPG)_" of "_$S($L(GMRCTPG)=1:$J("0"_GMRCTPG,2),1:GMRCTPG)_") containing Consult records which have an ampersand as **"
101 ... S GMRCMSG(4)="** the Significant Finding was "_$S($D(XMERR):"not sent due to an error in the message **",1:"sent to the "_$S(DUZ=.5:"postmaster. Please forward this **",1:"user. Please forward this **"))
102 ... I $D(XMERR) S GMRCMSG(5)="** setup. **"
103 ... I $D(XMERR) S GMRCMSG(6)="** Dumping message to screen. **"
104 ... I '$D(XMERR) S GMRCMSG(5)="** message to the appropriate staff, which includes the clinical **"
105 ... I '$D(XMERR) S GMRCMSG(6)="** coordinator, for further action. **"
106 .. I GMRCIFC="GMRCP50 IFC" D
107 ... S GMRCMSG(3)="** Message ("_$S($L(GMRCPG)=1:$J("0"_GMRCPG,2),1:GMRCPG)_" of "_$S($L(GMRCTPG)=1:$J("0"_GMRCTPG,2),1:GMRCTPG)_") containing Inter-Facility Consult records which have **"
108 ... S GMRCMSG(4)="** an ampersand as the Significant Finding was "_$S($D(XMERR):"not sent due to an error in **",1:"sent to the "_$S(DUZ=.5:"postmaster. **",1:"user. **"))
109 ... I $D(XMERR) S GMRCMSG(5)="** the message setup. **"
110 ... I $D(XMERR) S GMRCMSG(6)="** Dumping message to screen. **"
111 ... I '$D(XMERR) S GMRCMSG(5)="** Please forward this message to the appropriate staff, which includes the **"
112 ... I '$D(XMERR) S GMRCMSG(6)="** clinical coordinator, for further action. **"
113 .. S GMRCMSG(7)="******************************************************************************"
114 .. D BMES^XPDUTL(.GMRCMSG)
115 .. I $D(XMERR) D BMES^XPDUTL(" "),BMES^XPDUTL(.GMRCTXT)
116 . K ^TMP(GMRCIFC,$J)
117 Q
Note: See TracBrowser for help on using the repository browser.