source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SD53P177.m@ 1185

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

initial load of FOIAVistA 6/30/08 version

File size: 3.4 KB
Line 
1SD53P177 ;BP-CIOFO/KEITH - Patch SD*5.3*177 utility routine ; 8/27/99 3:28pm
2 ;;5.3;Scheduling;**177**;AUG 13, 1993
3 ;
4ENV ;environment check point.
5 ;
6 S XPDABORT=""
7 D PROGCHK(.XPDABORT) ;checks programmer variables
8 D DOMNCHK(.XPDABORT) ;checks Q domain for HL7
9 I XPDABORT="" K XPDABORT
10 Q
11 ;
12PRE ;Pre-init
13 D DFILE ;Delete entries in file #409.92
14 D OPT ;Change name of option SC PCMM GUI WORKSTATI0N
15 Q
16 ;
17DFILE ;Delete file #409.92 entries prior to install
18 Q:'$D(^SD(409.92))
19 N DIK,DA S DIK="^SD(409.92,",DA=0
20 D BMES^XPDUTL("Deleting file #409.92 entries...")
21 F S DA=$O(^SD(409.92,DA)) Q:'DA D ^DIK
22 Q
23 ;
24OPT ;Rename PCMM GUI option so pre-patch177 clients may not access
25 ;post-patch177 server routines.
26 ; From: SC PCMM GUI WORKSTATION
27 ; To: SCMC PCMM GUI WORKSTATION
28 ;
29 NEW NEW,OLD
30 S NEW="SCMC PCMM GUI WORKSTATION"
31 S OLD="SC PCMM GUI WORKSTATION"
32 ;
33 ;Quit if NEW option already exists.
34 Q:$$LKOPT^XPDMENU(NEW)
35 ;
36 ;Rename OLD option.
37 D RENAME^XPDMENU(OLD,NEW)
38 ;
39 D BMES^XPDUTL("Option SC PCMM GUI WORKSTATION renamed to SCMC PCMM GUI WORKSTATION")
40 Q
41 ;
42POST ;Post-init
43 D ENMAIN^SCMCCV3(21) ;Queue the Preceptor Conversion
44 D ERMT ;edit report menu text
45 D XREF ;Reindex 404.43, field .03
46 ; ; . queue inconsistency report
47 D SITE ;Stuff site number into file 771, field 3
48 Q
49 ;
50ERMT ;Edit report menu text values for GUI selection
51 ;
52 D BMES^XPDUTL("Editing menu text values for GUI report selection...")
53 N SCX,DA,DR,DIE
54 S SCX(1)="Pt. List for Team Assignments"
55 S SCX(2)="Detailed Patient Assignments"
56 S SCX(6)="Summary Listing of Teams"
57 S SCX(7)="Team Patient Listing"
58 S SCX(8)="Team Member Listing"
59 S DIE="^SD(404.92,",DR=".01///^S X=SCX",DA=0
60 F S DA=$O(SCX(DA)) Q:'DA S SCX=SCX(DA) D ^DIE
61 Q
62 ;
63PROGCHK(XPDABORT) ;checks for necessary programmer variables
64 ;
65 I '$G(DUZ)!($G(DUZ(0))'="@")!('$G(DT))!($G(U)'="^") DO
66 .D BMES^XPDUTL("*****")
67 .D MES^XPDUTL("Your programming variables are not set up properly.")
68 .D MES^XPDUTL("Installation aborted.")
69 .D MES^XPDUTL("*****")
70 .S XPDABORT=2
71 .Q
72 Q
73 ;
74DOMNCHK(XPDABORT) ;checks for the new Austin q-domain
75 ;
76 I '$$FIND1^DIC(4.2,,"QX","Q-NPQ.MED.VA.GOV","B") DO
77 .D BMES^XPDUTL("*****")
78 .D MES^XPDUTL("Installation of this patch requires that the domain")
79 .D MES^XPDUTL("Q-NPQ.MED.VA.GOV be defined (XM*999*125). Installation aborted.")
80 .D MES^XPDUTL("*****")
81 .S XPDABORT=2
82 .K ^TMP("DIERR",$J)
83 .Q
84 Q
85 ;
86SITE ;Put local site number in HL7 APPLICATION PARAMETER file (#771).
87 NEW FAC,SCERR,SCFDA,SCIENS
88 S FAC=+$P($$SITE^VASITE(),"^",3) ;Get facility number
89 Q:FAC=""
90 S SCIENS=$O(^HL(771,"B","PCMM",""))
91 Q:'SCIENS
92 S SCIENS=SCIENS_","
93 S SCFDA(771,SCIENS,3)=FAC
94 D FILE^DIE(,"SCFDA","SCERR")
95 Q
96XREF ;Queue reindexing of 404.43, field .03.
97 Q:$D(^SCPT(404.43,"ACTDFN")) ;Don't run multiple times.
98 ;
99 NEW SCDUZ,ZTDESC,ZTDTH,ZTIO,ZTRTN
100 S SCDUZ=DUZ
101 S ZTDTH=$H
102 S ZTIO=""
103 S ZTRTN="XREF1^SD53P177"
104 S ZTSAVE("SCDUZ")=""
105 S ZTDESC="PCMM Patch 177 reindexing"
106 D ^%ZTLOAD
107 I $D(ZTSK)[0 D ;
108 . D MES^XPDUTL("Reindexing of file 404.43 cancelled!")
109 E D ;
110 . D MES^XPDUTL("Reindexing of file 404.43 queued.")
111 . D MES^XPDUTL("Generating mail message with PCMM Inconsistency Report totals.")
112 Q
113XREF1 ;Reindex 404.43, field .03.
114 NEW DIK
115 S DIK="^SCPT(404.43,"
116 S DIK(1)=".03^ACTDFN2^ACTPC2"
117 D ENALL^DIK
118 ;
119 D MAIL^SCRPV1(SCDUZ) ;Send Brief type Inconsistency Report.
120 Q
Note: See TracBrowser for help on using the repository browser.