source: WorldVistAEHR/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCYP50.m@ 1582

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

initial load of WorldVistAEHR
File size: 4.8 KB
Line 
1GMRCYP50 ;ISP/TDP - POST INSTALL FOR GMRC*3*50 ; 5/2/2006
2 ;;3.0;CONSULT/REQUEST TRACKING;**50**;DEC 27, 1997;Build 8
3 Q
4 ;
5POST ; Start of Pre-init for patch GMRC*3*50
6 N GMRCTTL
7 K ^TMP("GMRCYP50",$J)
8 D BMES^XPDUTL("Starting Post-init...")
9 D BMES^XPDUTL(" Searching for Procedure Consults which have an Inter-Facility")
10 D MES^XPDUTL(" Consult as a Related Service.")
11 D MES^XPDUTL(" ")
12 D SEARCH
13 I GMRCTTL D MSG
14 I 'GMRCTTL D BMES^XPDUTL(" No invalid entries found.")
15 D BMES^XPDUTL("Post-init complete.")
16 Q
17 ;
18SEARCH ; Search RELATED SERVICES (#2) field of the GMRC PROCEDURE (#123.3) file
19 ; for invalid IFC services.
20 N GMRCMSG,GMRCMSG1,GMRCPIEN,GMRCPRC,GMRCSIEN,GMRCSVC,X,XX,Y
21 S (GMRCPRC,GMRCTTL)=0
22 F S GMRCPRC=$O(^GMR(123.3,"B",GMRCPRC)) Q:GMRCPRC="" D
23 . S GMRCPIEN=""
24 . F S GMRCPIEN=$O(^GMR(123.3,"B",GMRCPRC,GMRCPIEN)) Q:GMRCPIEN="" D
25 .. S GMRCSIEN=0
26 .. F S GMRCSIEN=$O(^GMR(123.3,GMRCPIEN,2,"B",GMRCSIEN)) Q:GMRCSIEN="" D
27 ... I '+$G(^GMR(123.5,+GMRCSIEN,"IFC")),'+$O(^GMR(123.5,+GMRCSIEN,"IFCS",0)) Q
28 ... S GMRCSVC=$P($G(^GMR(123.5,GMRCSIEN,0)),U,1)
29 ... I GMRCSVC="" S GMRCSVC="SERVICE UNKNOWN"
30 ... S ^TMP("GMRCYP50",$J,GMRCPRC_" (#"_GMRCPIEN_")",GMRCSVC_" (#"_GMRCSIEN_")")=""
31 ... K GMRCMSG
32 ... S GMRCMSG="Related Service, "_GMRCSVC_" (IEN #"_GMRCSIEN_"), associated with Consult Procedure, "_GMRCPRC_" (IEN #"_GMRCPIEN_"), is an Inter-Facility Consult Service and must be removed or replaced with a service which is not an IFC!"
33 ... S Y=0
34 ... F X=1:1 S GMRCMSG1=$E(GMRCMSG,Y,Y+61) D Q:Y'<$L(GMRCMSG)
35 .... I $L(GMRCMSG1)<61 S Y=Y+61,GMRCMSG(X)=GMRCMSG1 Q
36 .... F XX=61:-1:1 D Q:$D(GMRCMSG(X))
37 ..... I $E(GMRCMSG1,XX)'=" " Q
38 ..... S Y=Y+1+XX I X>1 S Y=Y-1
39 ..... S GMRCMSG(X)=$E(GMRCMSG1,1,XX)
40 ... S X=""
41 ... F S X=$O(GMRCMSG(X)) Q:X="" W !," "_$G(GMRCMSG(X))
42 ... W !
43 ... S GMRCTTL=GMRCTTL+1
44 ;D MES^XPDUTL(" ")
45 D BMES^XPDUTL(" "_GMRCTTL_" total invalid Related Services.")
46 Q
47 ;
48MSG ; Send Mailman message to installer
49 N GMRCC,GMRCCNT,GMRCPARM,GMRCPRC,GMRCSVC,GMRCTXT,GMRCWHO
50 N XMDUZ,XMERR,XMSUB,XMTEXT,XMY,Y
51 S XMSUB="RELATED SERVICES ARE INVALID"
52 I DUZ="" N DUZ S DUZ=.5 ; if user not defined set to postmaster
53 S XMDUZ=DUZ,XMTEXT="GMRCTXT"
54 S GMRCPARM("FROM")="PATCH GMRC*3.0*50 POST-INIT"
55 S XMY(DUZ)="" ; send message to user
56 S GMRCC=0
57 S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="This message has been sent by patch GMRC*3.0*50 at the completion of"
58 S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="the post-init routine."
59 S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "
60 S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="This message was sent because Consult Procedure records were found which"
61 S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="contained one or more Related Services which are setup as Inter-Facility"
62 S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="Consults. These related services should be removed and replaced with"
63 S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="non-IFC services to prevent possible problems in the Consult/Request"
64 S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="Tracking package. The following information is provided to assist you"
65 S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="in your cleanup efforts."
66 S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "
67 S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="PROCEDURE"
68 S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" RELATED SERVICE"
69 S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="==========================================================================="
70 S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "
71 S GMRCCNT=0,GMRCPRC=""
72 F S GMRCPRC=$O(^TMP("GMRCYP50",$J,GMRCPRC)) Q:GMRCPRC="" D
73 . S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=GMRCPRC
74 . S GMRCSVC=""
75 . F S GMRCSVC=$O(^TMP("GMRCYP50",$J,GMRCPRC,GMRCSVC)) Q:GMRCSVC="" D
76 .. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "_GMRCSVC
77 .. S GMRCCNT=GMRCCNT+1
78 . S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "
79 S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "
80 S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "
81 S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="Total invalid Related Services: "_GMRCCNT
82 D SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY,.GMRCPARM,"","")
83 S GMRCMSG(1)=" "
84 S GMRCMSG(2)="******************************************************************************"
85 S GMRCMSG(3)="** Message containing Procedure Consult records which have invalid **"
86 S GMRCMSG(4)="** Related Services was "_$S($D(XMERR):"not sent due to an error in the message set up. **",1:"sent to the "_$S(DUZ=.5:"postmaster. Please forward this **",1:"user. Please forward this **"))
87 I $D(XMERR) S GMRCMSG(5)="** Dumping message to screen. **"
88 I '$D(XMERR) S GMRCMSG(5)="** message to the appropriate staff, which includes the clinical **"
89 I '$D(XMERR) S GMRCMSG(6)="** coordinator, for further action. **"
90 S GMRCMSG($S($D(XMERR):6,1:7))="******************************************************************************"
91 D BMES^XPDUTL(.GMRCMSG)
92 I $D(XMERR) D BMES^XPDUTL(" "),BMES^XPDUTL(.GMRCTXT)
93 K ^TMP("GMRCYP50",$J)
94 Q
Note: See TracBrowser for help on using the repository browser.