source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCMSP.m@ 949

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

initial load of FOIAVistA 6/30/08 version
File size: 6.7 KB
Line 
1SCMSP ;ALB/MTC - POST INIT ROUTINE;28-MAY-1996
2 ;;5.3;Scheduling;**44**;AUG 13, 1993
3 ;
4HOPUP ;-- This function will update all the clinics in file #44 to
5 ; require Provider and Diagnosis for checkout. Using the "B"
6 ; x-ref a check will be performed to make sure that the location
7 ; is clinic then fields 26 (Ask provider@ CO) and 27 (Ask diagnosis
8 ; @ CO) will be set to 1 (REQUIRED).
9 ;
10 N SCX,SCY,SCZ,DIC,DIE,DA,DR,X,Y,%,%H,%I
11 N MSGTXT,XMB,XMTEXT,XMY,XMDUZ,XMDT,XMZ
12 ;
13 S SCX=0
14 F S SCX=$O(^SC("B",SCX)) Q:SCX="" S SCY=0 F S SCY=$O(^SC("B",SCX,SCY)) Q:'SCY D
15 . S SCZ=$G(^SC(SCY,0)) Q:SCZ=""
16 . I $P(SCZ,U,3)'="C" Q
17 . I $$OCCA^SCDXUTL(SCY) Q
18 . S DIE="^SC(",DA=SCY,DR="26///1;27///1" D ^DIE
19 ;Get current date/time
20 D NOW^%DTC
21 ;Convert to external format
22 S SCZ=$P(%,".",2)_"000000"
23 S SCY=$E(SCZ,1,2)_":"_$E(SCZ,3,4)_":"_$E(SCZ,5,6)
24 S SCX=%I(1)_"/"_%I(2)_"/"_(%I(3)+1700)_" @ "_SCY
25 ;Store completion time in Scheduling Parameter file
26 S SCZ=0
27 F X=1:1:10 L +^SD(404.91,1,"AMB"):5 I ($T) S SCZ=1 Q
28 S:(SCZ) $P(^SD(404.91,1,"AMB"),"^",7)=%
29 L -^SD(404.91,1,"AMB")
30 ;Send completion bulletin
31 ;Set message text
32 S MSGTXT(1)=" "
33 S MSGTXT(2)="Updating of all clinics contained in the HOSPITAL LOCATION"
34 S MSGTXT(3)="file (#44) to require provider and diagnosis for checkout"
35 S MSGTXT(4)="completed on "_SCX
36 S MSGTXT(5)=" "
37 ;Set bulletin subject
38 S XMB(1)="HOSPITAL LOCATION UPDATE COMPLETED"
39 ;Deliver bulletin
40 S XMB="SCDX AMBCARE TO NPCDB SUMMARY"
41 S XMTEXT="MSGTXT("
42 D ^XMB
43 Q
44 ;
45PARAM ;ALB/JLU - This entry point will set the Amb Care parameters in the
46 ; Scheduling parameter file
47 ;
48 N DIC,DIE,DA,DR,X,Y,DTOUT,DUOUT,MSGTXT,DELAY
49 N PTRPAR,DLAYGO,DINUM,NODE,TASKNUM,QUEUEDT
50 D BMES^XPDUTL(">>> Setting parameters contained in SCHEDULING PARAMETER file (#404.91)")
51 ;Create/find entry
52 S DIC="^SD(404.91,"
53 S DIC(0)="LX"
54 S DIC("DR")=".001///1"
55 S DLAYGO=404.91
56 S DINUM=1
57 S X=1
58 D ^DIC
59 S PTRPAR=+Y
60 ;Unable to create/find entry - quit
61 I (Y<0) D Q
62 .S MSGTXT(1)=" *** Unable to create/find entry in Scheduling Parameter file"
63 .S MSGTXT(2)=" *** Unable to store parameters relating to Ambulatory Care"
64 .D MES^XPDUTL(.MSGTXT)
65 ;Get check point's parameter data. This value will be in the
66 ; format QueueTime-TaskNumber
67 S X=$$PARCP^XPDUTL("SCMS01")
68 S QUEUEDT=$P(X,"-",1)
69 S TASKNUM=$P(X,"-",2)
70 ;Store Ambulatory Care parameters - using hard set since there's no
71 ; cross references on these fields
72 S NODE=$G(^SD(404.91,PTRPAR,"AMB"))
73 S $P(NODE,U,1)=+$P(NODE,U,1)
74 S $P(NODE,U,2)=2961001
75 S $P(NODE,U,3)=2961101
76 S DELAY=+$P(NODE,U,4)
77 S:('DELAY) DELAY=2
78 S $P(NODE,U,4)=DELAY
79 S $P(NODE,U,5)=QUEUEDT
80 S $P(NODE,U,6)=TASKNUM
81 S $P(NODE,U,7)="0000000"
82 S ^SD(404.91,1,"AMB")=NODE
83 D MES^XPDUTL(" Parameters relating to Ambulatory Care have been stored")
84 Q
85 ;
86MG4BULL ;ALB/JRP - Attach Mail Group that receives OPC generation bulletin
87 ; to the Ambulatory Care transmission summary bulletin
88 ;
89 ;Input : None
90 ;Output : None
91 ;Notes : This is a KIDS complient check point
92 ;
93 ;Declare variables
94 N DIC,DIE,DA,DR,X,Y,DTOUT,DUOUT,OPCMG,BULLNAME,PTRBULL,MSGTXT
95 D BMES^XPDUTL(">>> Attaching mail group to Ambulatory Care transmission summary bulletin")
96 ;Get name of Mail Group that receives OPC generation bulletin
97 S OPCMG=$$OPCMG^SCMSPU1(1)
98 I (OPCMG="") D Q
99 .S MSGTXT(1)=" ** MAS PARAMETER file (#43) does not have a value for"
100 .S MSGTXT(2)=" the OPC GENERATE MAIL GROUP field (#216)"
101 .S MSGTXT(3)=" ** Unable to attach mail group to the SCDX AMBCARE"
102 .S MSGTXT(4)=" TO NPCDB SUMMARY bulletin"
103 .S MSGTXT(5)=" ** Mail group must be added to bulletin manually"
104 .D MES^XPDUTL(.MSGTXT)
105 ;Get pointer to Ambulatory Care transmission summary bulletin
106 S BULLNAME="SCDX AMBCARE TO NPCDB SUMMARY"
107 S PTRBULL=+$O(^XMB(3.6,"B",BULLNAME,0))
108 I ('PTRBULL) D Q
109 .S MSGTXT(1)=" ** Unable to find entry for SCDX AMBCARE TO NPCDB"
110 .S MSGTXT(2)=" SUMMARY in BULLETIN file (#3.6)"
111 .S MSGTXT(3)=" ** Bulletin must be manually entered"
112 .D MES^XPDUTL(.MSGTXT)
113 ;Attach Mail Group to Ambulatory Care transmission summary bulletin
114 S DIC="^XMB(3.6,"_PTRBULL_",2,"
115 S DIC(0)="LX"
116 S DIC("P")=$P(^DD(3.6,4,0),"^",2)
117 S DA(1)=PTRBULL
118 S DLAYGO=3.6
119 S X=OPCMG
120 D ^DIC
121 S MSGTXT(1)=" Mail group contained in the OPC GENERATE MAIL GROUP"
122 S MSGTXT(2)=" field (#216) of the MAS PARAMETER file (#43) has"
123 S MSGTXT(3)=" been attached to the SCDX AMBCARE TO NPCDB SUMMARY bulletin"
124 I (Y<0) D
125 .K MSGTXT
126 .S MSGTXT(1)=" ** Unable to attach mail group to the SCDX AMBCARE"
127 .S MSGTXT(2)=" TO NPCDB SUMMARY bulletin"
128 .S MSGTXT(3)=" ** Mail group must be added to bulletin manually"
129 D MES^XPDUTL(.MSGTXT)
130 ;Done
131 Q
132 ;
133SDM ;ALB/JRP - Have an overlap routine with PCMM (SD*5.3*41)
134 ; Make sure that correct version of SDM routine is installed
135 ;
136 ;Input : None
137 ;Output : None
138 ;Notes : This is a KIDS complient check point
139 ; : Routine SCMSPX1 contains SDM with patch 41 applied to it
140 ; and routine SCMSPX2 contains SDM with patch 41 not applied
141 ; to it
142 ;
143 ;Declare variables
144 N PATCHED,TMP,MSGTXT
145 D BMES^XPDUTL(">>> Installing correct version of routine SDM")
146 ;Check for PCMM installation
147 S PATCHED=$$PATCH^XPDUTL("SD*5.3*41")
148 ;PCMM not installed - SDM should come from SCMSPX2
149 I ('PATCHED) D
150 .S MSGTXT(1)=" "
151 .S MSGTXT(2)=" PCMM has NOT been installed. Will install a version"
152 .S MSGTXT(3)=" of routine SDM that DOES NOT have the PCMM changes"
153 .S MSGTXT(4)=" applied to it."
154 .S MSGTXT(5)=" "
155 .S MSGTXT(6)=" MSM sites must copy the SDM routine to all appropriate UCIs"
156 .S MSGTXT(7)=" "
157 .S MSGTXT(8)=" ********** PLEASE NOTE THE FOLLOWING ***********"
158 .S MSGTXT(9)=" * *"
159 .S MSGTXT(10)=" * After installing PCMM, call the routine *"
160 .S MSGTXT(11)=" * SCMSP at theline tag SDM (i.e. D SDM^SCMSP) *"
161 .S MSGTXT(12)=" * in order to install a version of routine SDM *"
162 .S MSGTXT(13)=" * with the ACRP & PCMM changes applied to it. *"
163 .S MSGTXT(14)=" * *"
164 .S MSGTXT(15)=" * MSM sites will then need to copy the updated *"
165 .S MSGTXT(16)=" * SDM routine to all appropriate UCIs. *"
166 .S MSGTXT(17)=" * *"
167 .S MSGTXT(18)=" ************************************************"
168 .D MES^XPDUTL(.MSGTXT)
169 .S TMP=$$COPY^SCMSPU2("SCMSPX2","SDM",3)
170 ;PCMM installed - SDM should come from SCMSPX1
171 I (PATCHED) D
172 .S MSGTXT(1)=" "
173 .S MSGTXT(2)=" PCMM has been installed. Will install a version"
174 .S MSGTXT(3)=" of routine SDM that has the PCMM changes applied"
175 .S MSGTXT(4)=" to it"
176 .S MSGTXT(5)=" "
177 .S MSGTXT(6)=" MSM sites must copy the SDM routine to all appropriate UCIs"
178 .D MES^XPDUTL(.MSGTXT)
179 .S TMP=$$COPY^SCMSPU2("SCMSPX1","SDM",3)
180 ;Done
181 Q
Note: See TracBrowser for help on using the repository browser.