source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCMSP66.m@ 861

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

initial load of WorldVistAEHR
File size: 4.8 KB
RevLine 
[613]1SCMSP66 ;ALB/JLU;Post kids routine driver;8/13/97
2 ;;5.3;Scheduling;**66**;AUG 13, 1993
3 ;
4EN N TMP,ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK,SCQUEUE,X,Y,%,%H,PROTOCOL
5 ;Queue task to populate validator parameter in clinic setup
6 I XPDQUES("POS1")=1 D
7 .S TMP="NOW"
8 .D BMES^XPDUTL("Background job to activate AMBCARE validation checker at")
9 .D MES^XPDUTL("Check-Out for all clinics will be queued for "_TMP)
10 .S ZTDTH=$H,ZTIO="",ZTRTN="VALIDATE^SCMSP66"
11 .D ^%ZTLOAD
12 .S ZTSK=+$G(ZTSK)
13 .I ('ZTSK) D BMES^XPDUTL("*** Unable to queue task ***")
14 .I (ZTSK) D BMES^XPDUTL("Queued as task number "_ZTSK)
15 .Q
16 ;
17 D BMES^XPDUTL("")
18 D BMES^XPDUTL("Removing AMBCARE event handler from Scheduling event driver item list.")
19 S PROTOCOL=""
20 D REMOVE(.PROTOCOL)
21 ;
22 D BMES^XPDUTL("")
23 D BMES^XPDUTL("Adding AMBCARE event handler to the exit action of SDAM APPOINTMENT EVENTS")
24 D ADD(PROTOCOL)
25 ;
26 I '$D(^SD(409.75,"AEDT")) DO
27 .D BMES^XPDUTL("")
28 .D BMES^XPDUTL("Re-indexing the four new cross references in the Transmitted Outpatient Encounter Error file.")
29 .S DIK="^SD(409.75,",DIK(1)=".01^AEDT^AECL^AER^ACOD"
30 .D ENALL^DIK
31 .D MES^XPDUTL("Re-indexing completed!")
32 .Q
33 ;
34 I '$D(^DD(409.76,0,"ID",11)) DO
35 .S $P(^SD(409.76,0),U,2)=$P(^SD(409.76,0),U,2)_"I"
36 .S ^DD(409.76,0,"ID",11)="D EN^DDIOL($P(^(1),U,1))"
37 .Q
38 ;
39 Q
40 ;
41VALIDATE ;
42 ;This entry point will set the parameter in the clinic setup to yes
43 ;run the validator at check out. It will be queued from the post init
44 ;of the KIDS build SD*5.3*66. It will also send a completion bulletin
45 ;to the SCDX AMBCARE bulletin group.
46 ;
47 N SCX,SCY,SCZ,DIC,DIE,DA,DR,X,Y,%,%H,%I
48 N MSGTXT,XMB,XMTEXT,XMY,XMDUZ,XMDT,XMZ
49 ;
50 S SCX=0
51 ;looping through the Hospital Location to set the clinics
52 F S SCX=$O(^SC("B",SCX)) Q:SCX="" S SCY=0 F S SCY=$O(^SC("B",SCX,SCY)) Q:'SCY D
53 . S SCZ=$G(^SC(SCY,0)) Q:SCZ=""
54 . I $P(SCZ,U,3)'="C" Q
55 . I $$OCCA^SCDXUTL(SCY) Q
56 . S DIE="^SC(",DA=SCY,DR="30///1" D ^DIE
57 ;Get current date/time
58 D NOW^%DTC
59 ;Convert to external format
60 S SCZ=$P(%,".",2)_"000000"
61 S SCY=$E(SCZ,1,2)_":"_$E(SCZ,3,4)_":"_$E(SCZ,5,6)
62 S SCX=%I(1)_"/"_%I(2)_"/"_(%I(3)+1700)_" @ "_SCY
63 ;Send completion bulletin
64 ;Set message text
65 S MSGTXT(1)=" "
66 S MSGTXT(2)="Updating of all clinics contained in the HOSPITAL LOCATION"
67 S MSGTXT(3)="file (#44) to run the AMBCARE validator at Check-Out was"
68 S MSGTXT(4)="completed on "_SCX
69 S MSGTXT(5)=" "
70 ;Set bulletin subject
71 S XMB(1)="HOSPITAL LOCATION UPDATE COMPLETED"
72 ;Deliver bulletin
73 S XMB="SCDX AMBCARE TO NPCDB SUMMARY"
74 S XMTEXT="MSGTXT("
75 D ^XMB
76 Q
77 ;
78REMOVE(PROTOCOL) ;This entry point will remove the SCDX AMBCARE EVENT handler from the
79 ;SDAM APPOINTMENT EVENT protocol. A bulletin will be sent upon
80 ;completion.
81 ;
82 N ERR,DIC,X,Y
83 S ERR=0
84 ;find SDAM APPOINTMENT EVENT
85 S DIC="^ORD(101,",DIC(0)="OSX",X="SDAM APPOINTMENT EVENTS"
86 D ^DIC
87 I Y<0 S ERR=1 G RQUIT
88 S PROTOCOL=+Y
89 ;find SCDX AMBCARE EVENT protocol in item list
90 S DIC="^ORD(101,"_PROTOCOL_",10,",DIC(0)="OSX",X="SCDX AMBCARE EVENT"
91 D ^DIC
92 I Y<0 S ERR=1 G RQUIT
93 ;
94 S DIK="^ORD(101,"_PROTOCOL_",10,"
95 S DA=+Y,DA(1)=PROTOCOL
96 D ^DIK
97 K DIK,DA
98 ;
99RQUIT ;
100 D BMES^XPDUTL("Removal of SCDX AMBCARE EVENT protocol from the Scheduling Event driver")
101 D MES^XPDUTL($S(ERR:"was not completed. Please review the installation instructions of this patch.",1:"was completed."))
102 Q
103 ;
104ADD(PROTOCOL) ;Adds the AMBCARE event handler to the exit action of SDAM
105 ;APPOINTMENT EVENTS protocol.
106 ;
107 I PROTOCOL="" DO Q
108 .D BMES^XPDUTL("")
109 .D MES^XPDUTL("The protocol 'SDAM APPOINTMENT EVENTS' could not be found.")
110 .D MES^XPDUTL("Please review the installation instructions for this patch.")
111 .Q
112 N CONTENTS,DIC,DR,DA,DIQ,OLD
113 S DIC="^ORD(101,",DR=15,DA=PROTOCOL,DIQ="RES",DIQ(0)="E"
114 D EN^DIQ1
115 ;
116 ;nothing in the exit action just add.
117 I RES(101,DA,15,"E")="" D LOAD(DA,"D EN^SCDXHLDR","") Q
118 ;
119 ;the call to scdxhldr already exists.
120 I RES(101,DA,15,"E")["SCDXHLDR" DO Q
121 .D BMES^XPDUTL("")
122 .D MES^XPDUTL("The AMBCARE event handler call exists in the Scheduling event driver exit action!")
123 .Q
124 ;save off old line and try building a new one
125 S OLD=RES(101,DA,15,"E")
126 S RES(101,DA,15,"E")=RES(101,DA,15,"E")_" D EN^SCDXHLDR"
127 D LOAD(DA,RES(101,DA,15,"E"),OLD)
128 Q
129 ;
130LOAD(DA,DATA,OLD) ;
131 N SCMS,SCIENS
132 S SCIENS=DA_","
133 S SCMS(101,SCIENS,15)=DATA
134 ;
135 D FILE^DIE("KE","SCMS","SCMS(""ERR"")")
136 ;if no error
137 I '$D(SCMS("ERR")) DO Q
138 .D BMES^XPDUTL("")
139 .D MES^XPDUTL("Updating of 'SDAM APPOINTMENT EVENTS' exit action complete!")
140 .Q
141 K SCMS("ERR")
142 ;file only our stuff and post error
143 S SCMS(101,SCIENS,15)="D EN^SCDXHLDR"
144 D FILE^DIE("KE","SCMS","SCMS(""ERR"")")
145 D BMES^XPDUTL("")
146 D MES^XPDUTL("The exit action for 'SDAM APPOINTMENT EVENTS' on your system was:")
147 D MES^XPDUTL(OLD)
148 D MES^XPDUTL("An attempt was made to replace it, but failed.")
149 D BMES^XPDUTL("It has been replaced with D EN^SCDXHLDR")
150 D MES^XPDUTL("You will need to edit this protocol's exit action to restore your changes.")
151 Q
Note: See TracBrowser for help on using the repository browser.