Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SCMSP66

SCMSP66.m

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