SCMSP66 ;ALB/JLU;Post kids routine driver;8/13/97
;;5.3;Scheduling;**66**;AUG 13, 1993
;
EN N TMP,ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK,SCQUEUE,X,Y,%,%H,PROTOCOL
;Queue task to populate validator parameter in clinic setup
I XPDQUES("POS1")=1 D
.S TMP="NOW"
.D BMES^XPDUTL("Background job to activate AMBCARE validation checker at")
.D MES^XPDUTL("Check-Out for all clinics will be queued for "_TMP)
.S ZTDTH=$H,ZTIO="",ZTRTN="VALIDATE^SCMSP66"
.D ^%ZTLOAD
.S ZTSK=+$G(ZTSK)
.I ('ZTSK) D BMES^XPDUTL("*** Unable to queue task ***")
.I (ZTSK) D BMES^XPDUTL("Queued as task number "_ZTSK)
.Q
;
D BMES^XPDUTL("")
D BMES^XPDUTL("Removing AMBCARE event handler from Scheduling event driver item list.")
S PROTOCOL=""
D REMOVE(.PROTOCOL)
;
D BMES^XPDUTL("")
D BMES^XPDUTL("Adding AMBCARE event handler to the exit action of SDAM APPOINTMENT EVENTS")
D ADD(PROTOCOL)
;
I '$D(^SD(409.75,"AEDT")) DO
.D BMES^XPDUTL("")
.D BMES^XPDUTL("Re-indexing the four new cross references in the Transmitted Outpatient Encounter Error file.")
.S DIK="^SD(409.75,",DIK(1)=".01^AEDT^AECL^AER^ACOD"
.D ENALL^DIK
.D MES^XPDUTL("Re-indexing completed!")
.Q
;
I '$D(^DD(409.76,0,"ID",11)) DO
.S $P(^SD(409.76,0),U,2)=$P(^SD(409.76,0),U,2)_"I"
.S ^DD(409.76,0,"ID",11)="D EN^DDIOL($P(^(1),U,1))"
.Q
;
Q
;
VALIDATE ;
;This entry point will set the parameter in the clinic setup to yes
;run the validator at check out. It will be queued from the post init
;of the KIDS build SD*5.3*66. It will also send a completion bulletin
;to the SCDX AMBCARE bulletin group.
;
N SCX,SCY,SCZ,DIC,DIE,DA,DR,X,Y,%,%H,%I
N MSGTXT,XMB,XMTEXT,XMY,XMDUZ,XMDT,XMZ
;
S SCX=0
;looping through the Hospital Location to set the clinics
F S SCX=$O(^SC("B",SCX)) Q:SCX="" S SCY=0 F S SCY=$O(^SC("B",SCX,SCY)) Q:'SCY D
. S SCZ=$G(^SC(SCY,0)) Q:SCZ=""
. I $P(SCZ,U,3)'="C" Q
. I $$OCCA^SCDXUTL(SCY) Q
. S DIE="^SC(",DA=SCY,DR="30///1" D ^DIE
;Get current date/time
D NOW^%DTC
;Convert to external format
S SCZ=$P(%,".",2)_"000000"
S SCY=$E(SCZ,1,2)_":"_$E(SCZ,3,4)_":"_$E(SCZ,5,6)
S SCX=%I(1)_"/"_%I(2)_"/"_(%I(3)+1700)_" @ "_SCY
;Send completion bulletin
;Set message text
S MSGTXT(1)=" "
S MSGTXT(2)="Updating of all clinics contained in the HOSPITAL LOCATION"
S MSGTXT(3)="file (#44) to run the AMBCARE validator at Check-Out was"
S MSGTXT(4)="completed on "_SCX
S MSGTXT(5)=" "
;Set bulletin subject
S XMB(1)="HOSPITAL LOCATION UPDATE COMPLETED"
;Deliver bulletin
S XMB="SCDX AMBCARE TO NPCDB SUMMARY"
S XMTEXT="MSGTXT("
D ^XMB
Q
;
REMOVE(PROTOCOL) ;This entry point will remove the SCDX AMBCARE EVENT handler from the
;SDAM APPOINTMENT EVENT protocol. A bulletin will be sent upon
;completion.
;
N ERR,DIC,X,Y
S ERR=0
;find SDAM APPOINTMENT EVENT
S DIC="^ORD(101,",DIC(0)="OSX",X="SDAM APPOINTMENT EVENTS"
D ^DIC
I Y<0 S ERR=1 G RQUIT
S PROTOCOL=+Y
;find SCDX AMBCARE EVENT protocol in item list
S DIC="^ORD(101,"_PROTOCOL_",10,",DIC(0)="OSX",X="SCDX AMBCARE EVENT"
D ^DIC
I Y<0 S ERR=1 G RQUIT
;
S DIK="^ORD(101,"_PROTOCOL_",10,"
S DA=+Y,DA(1)=PROTOCOL
D ^DIK
K DIK,DA
;
RQUIT ;
D BMES^XPDUTL("Removal of SCDX AMBCARE EVENT protocol from the Scheduling Event driver")
D MES^XPDUTL($S(ERR:"was not completed. Please review the installation instructions of this patch.",1:"was completed."))
Q
;
ADD(PROTOCOL) ;Adds the AMBCARE event handler to the exit action of SDAM
;APPOINTMENT EVENTS protocol.
;
I PROTOCOL="" DO Q
.D BMES^XPDUTL("")
.D MES^XPDUTL("The protocol 'SDAM APPOINTMENT EVENTS' could not be found.")
.D MES^XPDUTL("Please review the installation instructions for this patch.")
.Q
N CONTENTS,DIC,DR,DA,DIQ,OLD
S DIC="^ORD(101,",DR=15,DA=PROTOCOL,DIQ="RES",DIQ(0)="E"
D EN^DIQ1
;
;nothing in the exit action just add.
I RES(101,DA,15,"E")="" D LOAD(DA,"D EN^SCDXHLDR","") Q
;
;the call to scdxhldr already exists.
I RES(101,DA,15,"E")["SCDXHLDR" DO Q
.D BMES^XPDUTL("")
.D MES^XPDUTL("The AMBCARE event handler call exists in the Scheduling event driver exit action!")
.Q
;save off old line and try building a new one
S OLD=RES(101,DA,15,"E")
S RES(101,DA,15,"E")=RES(101,DA,15,"E")_" D EN^SCDXHLDR"
D LOAD(DA,RES(101,DA,15,"E"),OLD)
Q
;
LOAD(DA,DATA,OLD) ;
N SCMS,SCIENS
S SCIENS=DA_","
S SCMS(101,SCIENS,15)=DATA
;
D FILE^DIE("KE","SCMS","SCMS(""ERR"")")
;if no error
I '$D(SCMS("ERR")) DO Q
.D BMES^XPDUTL("")
.D MES^XPDUTL("Updating of 'SDAM APPOINTMENT EVENTS' exit action complete!")
.Q
K SCMS("ERR")
;file only our stuff and post error
S SCMS(101,SCIENS,15)="D EN^SCDXHLDR"
D FILE^DIE("KE","SCMS","SCMS(""ERR"")")
D BMES^XPDUTL("")
D MES^XPDUTL("The exit action for 'SDAM APPOINTMENT EVENTS' on your system was:")
D MES^XPDUTL(OLD)
D MES^XPDUTL("An attempt was made to replace it, but failed.")
D BMES^XPDUTL("It has been replaced with D EN^SCDXHLDR")
D MES^XPDUTL("You will need to edit this protocol's exit action to restore your changes.")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMSP66 5106 printed Apr 09, 2024@22:05:07 Page 2
SCMSP66 ;ALB/JLU;Post kids routine driver;8/13/97
+1 ;;5.3;Scheduling;**66**;AUG 13, 1993
+2 ;
EN NEW TMP,ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK,SCQUEUE,X,Y,%,%H,PROTOCOL
+1 ;Queue task to populate validator parameter in clinic setup
+2 IF XPDQUES("POS1")=1
Begin DoDot:1
+3 SET TMP="NOW"
+4 DO BMES^XPDUTL("Background job to activate AMBCARE validation checker at")
+5 DO MES^XPDUTL("Check-Out for all clinics will be queued for "_TMP)
+6 SET ZTDTH=$HOROLOG
SET ZTIO=""
SET ZTRTN="VALIDATE^SCMSP66"
+7 DO ^%ZTLOAD
+8 SET ZTSK=+$GET(ZTSK)
+9 IF ('ZTSK)
DO BMES^XPDUTL("*** Unable to queue task ***")
+10 IF (ZTSK)
DO BMES^XPDUTL("Queued as task number "_ZTSK)
+11 QUIT
End DoDot:1
+12 ;
+13 DO BMES^XPDUTL("")
+14 DO BMES^XPDUTL("Removing AMBCARE event handler from Scheduling event driver item list.")
+15 SET PROTOCOL=""
+16 DO REMOVE(.PROTOCOL)
+17 ;
+18 DO BMES^XPDUTL("")
+19 DO BMES^XPDUTL("Adding AMBCARE event handler to the exit action of SDAM APPOINTMENT EVENTS")
+20 DO ADD(PROTOCOL)
+21 ;
+22 IF '$DATA(^SD(409.75,"AEDT"))
Begin DoDot:1
+23 DO BMES^XPDUTL("")
+24 DO BMES^XPDUTL("Re-indexing the four new cross references in the Transmitted Outpatient Encounter Error file.")
+25 SET DIK="^SD(409.75,"
SET DIK(1)=".01^AEDT^AECL^AER^ACOD"
+26 DO ENALL^DIK
+27 DO MES^XPDUTL("Re-indexing completed!")
+28 QUIT
End DoDot:1
+29 ;
+30 IF '$DATA(^DD(409.76,0,"ID",11))
Begin DoDot:1
+31 SET $PIECE(^SD(409.76,0),U,2)=$PIECE(^SD(409.76,0),U,2)_"I"
+32 SET ^DD(409.76,0,"ID",11)="D EN^DDIOL($P(^(1),U,1))"
+33 QUIT
End DoDot:1
+34 ;
+35 QUIT
+36 ;
VALIDATE ;
+1 ;This entry point will set the parameter in the clinic setup to yes
+2 ;run the validator at check out. It will be queued from the post init
+3 ;of the KIDS build SD*5.3*66. It will also send a completion bulletin
+4 ;to the SCDX AMBCARE bulletin group.
+5 ;
+6 NEW SCX,SCY,SCZ,DIC,DIE,DA,DR,X,Y,%,%H,%I
+7 NEW MSGTXT,XMB,XMTEXT,XMY,XMDUZ,XMDT,XMZ
+8 ;
+9 SET SCX=0
+10 ;looping through the Hospital Location to set the clinics
+11 FOR
SET SCX=$ORDER(^SC("B",SCX))
if SCX=""
QUIT
SET SCY=0
FOR
SET SCY=$ORDER(^SC("B",SCX,SCY))
if 'SCY
QUIT
Begin DoDot:1
+12 SET SCZ=$GET(^SC(SCY,0))
if SCZ=""
QUIT
+13 IF $PIECE(SCZ,U,3)'="C"
QUIT
+14 IF $$OCCA^SCDXUTL(SCY)
QUIT
+15 SET DIE="^SC("
SET DA=SCY
SET DR="30///1"
DO ^DIE
End DoDot:1
+16 ;Get current date/time
+17 DO NOW^%DTC
+18 ;Convert to external format
+19 SET SCZ=$PIECE(%,".",2)_"000000"
+20 SET SCY=$EXTRACT(SCZ,1,2)_":"_$EXTRACT(SCZ,3,4)_":"_$EXTRACT(SCZ,5,6)
+21 SET SCX=%I(1)_"/"_%I(2)_"/"_(%I(3)+1700)_" @ "_SCY
+22 ;Send completion bulletin
+23 ;Set message text
+24 SET MSGTXT(1)=" "
+25 SET MSGTXT(2)="Updating of all clinics contained in the HOSPITAL LOCATION"
+26 SET MSGTXT(3)="file (#44) to run the AMBCARE validator at Check-Out was"
+27 SET MSGTXT(4)="completed on "_SCX
+28 SET MSGTXT(5)=" "
+29 ;Set bulletin subject
+30 SET XMB(1)="HOSPITAL LOCATION UPDATE COMPLETED"
+31 ;Deliver bulletin
+32 SET XMB="SCDX AMBCARE TO NPCDB SUMMARY"
+33 SET XMTEXT="MSGTXT("
+34 DO ^XMB
+35 QUIT
+36 ;
REMOVE(PROTOCOL) ;This entry point will remove the SCDX AMBCARE EVENT handler from the
+1 ;SDAM APPOINTMENT EVENT protocol. A bulletin will be sent upon
+2 ;completion.
+3 ;
+4 NEW ERR,DIC,X,Y
+5 SET ERR=0
+6 ;find SDAM APPOINTMENT EVENT
+7 SET DIC="^ORD(101,"
SET DIC(0)="OSX"
SET X="SDAM APPOINTMENT EVENTS"
+8 DO ^DIC
+9 IF Y<0
SET ERR=1
GOTO RQUIT
+10 SET PROTOCOL=+Y
+11 ;find SCDX AMBCARE EVENT protocol in item list
+12 SET DIC="^ORD(101,"_PROTOCOL_",10,"
SET DIC(0)="OSX"
SET X="SCDX AMBCARE EVENT"
+13 DO ^DIC
+14 IF Y<0
SET ERR=1
GOTO RQUIT
+15 ;
+16 SET DIK="^ORD(101,"_PROTOCOL_",10,"
+17 SET DA=+Y
SET DA(1)=PROTOCOL
+18 DO ^DIK
+19 KILL DIK,DA
+20 ;
RQUIT ;
+1 DO BMES^XPDUTL("Removal of SCDX AMBCARE EVENT protocol from the Scheduling Event driver")
+2 DO MES^XPDUTL($SELECT(ERR:"was not completed. Please review the installation instructions of this patch.",1:"was completed."))
+3 QUIT
+4 ;
ADD(PROTOCOL) ;Adds the AMBCARE event handler to the exit action of SDAM
+1 ;APPOINTMENT EVENTS protocol.
+2 ;
+3 IF PROTOCOL=""
Begin DoDot:1
+4 DO BMES^XPDUTL("")
+5 DO MES^XPDUTL("The protocol 'SDAM APPOINTMENT EVENTS' could not be found.")
+6 DO MES^XPDUTL("Please review the installation instructions for this patch.")
+7 QUIT
End DoDot:1
QUIT
+8 NEW CONTENTS,DIC,DR,DA,DIQ,OLD
+9 SET DIC="^ORD(101,"
SET DR=15
SET DA=PROTOCOL
SET DIQ="RES"
SET DIQ(0)="E"
+10 DO EN^DIQ1
+11 ;
+12 ;nothing in the exit action just add.
+13 IF RES(101,DA,15,"E")=""
DO LOAD(DA,"D EN^SCDXHLDR","")
QUIT
+14 ;
+15 ;the call to scdxhldr already exists.
+16 IF RES(101,DA,15,"E")["SCDXHLDR"
Begin DoDot:1
+17 DO BMES^XPDUTL("")
+18 DO MES^XPDUTL("The AMBCARE event handler call exists in the Scheduling event driver exit action!")
+19 QUIT
End DoDot:1
QUIT
+20 ;save off old line and try building a new one
+21 SET OLD=RES(101,DA,15,"E")
+22 SET RES(101,DA,15,"E")=RES(101,DA,15,"E")_" D EN^SCDXHLDR"
+23 DO LOAD(DA,RES(101,DA,15,"E"),OLD)
+24 QUIT
+25 ;
LOAD(DA,DATA,OLD) ;
+1 NEW SCMS,SCIENS
+2 SET SCIENS=DA_","
+3 SET SCMS(101,SCIENS,15)=DATA
+4 ;
+5 DO FILE^DIE("KE","SCMS","SCMS(""ERR"")")
+6 ;if no error
+7 IF '$DATA(SCMS("ERR"))
Begin DoDot:1
+8 DO BMES^XPDUTL("")
+9 DO MES^XPDUTL("Updating of 'SDAM APPOINTMENT EVENTS' exit action complete!")
+10 QUIT
End DoDot:1
QUIT
+11 KILL SCMS("ERR")
+12 ;file only our stuff and post error
+13 SET SCMS(101,SCIENS,15)="D EN^SCDXHLDR"
+14 DO FILE^DIE("KE","SCMS","SCMS(""ERR"")")
+15 DO BMES^XPDUTL("")
+16 DO MES^XPDUTL("The exit action for 'SDAM APPOINTMENT EVENTS' on your system was:")
+17 DO MES^XPDUTL(OLD)
+18 DO MES^XPDUTL("An attempt was made to replace it, but failed.")
+19 DO BMES^XPDUTL("It has been replaced with D EN^SCDXHLDR")
+20 DO MES^XPDUTL("You will need to edit this protocol's exit action to restore your changes.")
+21 QUIT
