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

SCMSP.m

Go to the documentation of this file. 
  1. SCMSP ;ALB/MTC - POST INIT ROUTINE;28-MAY-1996
  1.  ;;5.3;Scheduling;**44,1015**;AUG 13, 1993;Build 21
  1.  ;
  1. HOPUP ;-- This function will update all the clinics in file #44 to
  1.  ;   require Provider and Diagnosis for checkout. Using the "B"
  1.  ;   x-ref a check will be performed to make sure that the location
  1.  ;   is clinic then fields 26 (Ask provider@ CO) and 27 (Ask diagnosis
  1.  ;   @ CO) will be set to 1 (REQUIRED).
  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.  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="26///1;27///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.  ;Store completion time in Scheduling Parameter file
  1.  S SCZ=0
  1.  F X=1:1:10 L +^SD(404.91,1,"AMB"):5 I ($T) S SCZ=1 Q
  1.  S:(SCZ) $P(^SD(404.91,1,"AMB"),"^",7)=%
  1.  L -^SD(404.91,1,"AMB")
  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 require provider and diagnosis for checkout"
  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. PARAM ;ALB/JLU - This entry point will set the Amb Care parameters in the
  1.  ; Scheduling parameter file
  1.  ;
  1.  N DIC,DIE,DA,DR,X,Y,DTOUT,DUOUT,MSGTXT,DELAY
  1.  N PTRPAR,DLAYGO,DINUM,NODE,TASKNUM,QUEUEDT
  1.  D BMES^XPDUTL(">>> Setting parameters contained in SCHEDULING PARAMETER file (#404.91)")
  1.  ;Create/find entry
  1.  S DIC="^SD(404.91,"
  1.  S DIC(0)="LX"
  1.  S DIC("DR")=".001///1"
  1.  S DLAYGO=404.91
  1.  S DINUM=1
  1.  S X=1
  1.  D ^DIC
  1.  S PTRPAR=+Y
  1.  ;Unable to create/find entry - quit
  1.  I (Y<0) D  Q
  1.  .S MSGTXT(1)="   *** Unable to create/find entry in Scheduling Parameter file"
  1.  .S MSGTXT(2)="   *** Unable to store parameters relating to Ambulatory Care"
  1.  .D MES^XPDUTL(.MSGTXT)
  1.  ;Get check point's parameter data.  This value will be in the
  1.  ; format QueueTime-TaskNumber
  1.  S X=$$PARCP^XPDUTL("SCMS01")
  1.  S QUEUEDT=$P(X,"-",1)
  1.  S TASKNUM=$P(X,"-",2)
  1.  ;Store Ambulatory Care parameters - using hard set since there's no
  1.  ; cross references on these fields
  1.  S NODE=$G(^SD(404.91,PTRPAR,"AMB"))
  1.  S $P(NODE,U,1)=+$P(NODE,U,1)
  1.  S $P(NODE,U,2)=2961001
  1.  S $P(NODE,U,3)=2961101
  1.  S DELAY=+$P(NODE,U,4)
  1.  S:('DELAY) DELAY=2
  1.  S $P(NODE,U,4)=DELAY
  1.  S $P(NODE,U,5)=QUEUEDT
  1.  S $P(NODE,U,6)=TASKNUM
  1.  S $P(NODE,U,7)="0000000"
  1.  S ^SD(404.91,1,"AMB")=NODE
  1.  D MES^XPDUTL("    Parameters relating to Ambulatory Care have been stored")
  1.  Q
  1.  ;
  1. MG4BULL ;ALB/JRP - Attach Mail Group that receives OPC generation bulletin
  1.  ; to the Ambulatory Care transmission summary bulletin
  1.  ;
  1.  ;Input  : None
  1.  ;Output : None
  1.  ;Notes  : This is a KIDS complient check point
  1.  ;
  1.  ;Declare variables
  1.  N DIC,DIE,DA,DR,X,Y,DTOUT,DUOUT,OPCMG,BULLNAME,PTRBULL,MSGTXT
  1.  D BMES^XPDUTL(">>> Attaching mail group to Ambulatory Care transmission summary bulletin")
  1.  ;Get name of Mail Group that receives OPC generation bulletin
  1.  S OPCMG=$$OPCMG^SCMSPU1(1)
  1.  I (OPCMG="") D  Q
  1.  .S MSGTXT(1)="    ** MAS PARAMETER file (#43) does not have a value for"
  1.  .S MSGTXT(2)="       the OPC GENERATE MAIL GROUP field (#216)"
  1.  .S MSGTXT(3)="    ** Unable to attach mail group to the SCDX AMBCARE"
  1.  .S MSGTXT(4)="       TO NPCDB SUMMARY bulletin"
  1.  .S MSGTXT(5)="    ** Mail group must be added to bulletin manually"
  1.  .D MES^XPDUTL(.MSGTXT)
  1.  ;Get pointer to Ambulatory Care transmission summary bulletin
  1.  S BULLNAME="SCDX AMBCARE TO NPCDB SUMMARY"
  1.  S PTRBULL=+$O(^XMB(3.6,"B",BULLNAME,0))
  1.  I ('PTRBULL) D  Q
  1.  .S MSGTXT(1)="    ** Unable to find entry for SCDX AMBCARE TO NPCDB"
  1.  .S MSGTXT(2)="       SUMMARY in BULLETIN file (#3.6)"
  1.  .S MSGTXT(3)="    ** Bulletin must be manually entered"
  1.  .D MES^XPDUTL(.MSGTXT)
  1.  ;Attach Mail Group to Ambulatory Care transmission summary bulletin
  1.  S DIC="^XMB(3.6,"_PTRBULL_",2,"
  1.  S DIC(0)="LX"
  1.  S DIC("P")=$P(^DD(3.6,4,0),"^",2)
  1.  S DA(1)=PTRBULL
  1.  S DLAYGO=3.6
  1.  S X=OPCMG
  1.  D ^DIC
  1.  S MSGTXT(1)="    Mail group contained in the OPC GENERATE MAIL GROUP"
  1.  S MSGTXT(2)="    field (#216) of the MAS PARAMETER file (#43) has"
  1.  S MSGTXT(3)="    been attached to the SCDX AMBCARE TO NPCDB SUMMARY bulletin"
  1.  I (Y<0) D
  1.  .K MSGTXT
  1.  .S MSGTXT(1)="    ** Unable to attach mail group to the SCDX AMBCARE"
  1.  .S MSGTXT(2)="       TO NPCDB SUMMARY bulletin"
  1.  .S MSGTXT(3)="    ** Mail group must be added to bulletin manually"
  1.  D MES^XPDUTL(.MSGTXT)
  1.  ;Done
  1.  Q
  1.  ;
  1. SDM ;ALB/JRP - Have an overlap routine with PCMM (SD*5.3*41)
  1.  ;          Make sure that correct version of SDM routine is installed
  1.  ;
  1.  ;Input  : None
  1.  ;Output : None
  1.  ;Notes  : This is a KIDS complient check point
  1.  ;       : Routine SCMSPX1 contains SDM with patch 41 applied to it
  1.  ;         and routine SCMSPX2 contains SDM with patch 41 not applied
  1.  ;         to it
  1.  ;
  1.  ;Declare variables
  1.  N PATCHED,TMP,MSGTXT
  1.  D BMES^XPDUTL(">>> Installing correct version of routine SDM")
  1.  ;Check for PCMM installation
  1.  S PATCHED=$$PATCH^XPDUTL("SD*5.3*41")
  1.  ;PCMM not installed - SDM should come from SCMSPX2
  1.  I ('PATCHED) D
  1.  .S MSGTXT(1)=" "
  1.  .S MSGTXT(2)="    PCMM has NOT been installed.  Will install a version"
  1.  .S MSGTXT(3)="    of routine SDM that DOES NOT have the PCMM changes"
  1.  .S MSGTXT(4)="    applied to it."
  1.  .S MSGTXT(5)=" "
  1.  .S MSGTXT(6)="    MSM sites must copy the SDM routine to all appropriate UCIs"
  1.  .S MSGTXT(7)=" "
  1.  .S MSGTXT(8)="    ********** PLEASE NOTE THE FOLLOWING ***********"
  1.  .S MSGTXT(9)="    *                                              *"
  1.  .S MSGTXT(10)="    * After installing PCMM, call the routine      *"
  1.  .S MSGTXT(11)="    * SCMSP at theline tag SDM (i.e. D SDM^SCMSP)  *"
  1.  .S MSGTXT(12)="    * in order to install a version of routine SDM *"
  1.  .S MSGTXT(13)="    * with the ACRP & PCMM changes applied to it.  *"
  1.  .S MSGTXT(14)="    *                                              *"
  1.  .S MSGTXT(15)="    * MSM sites will then need to copy the updated *"
  1.  .S MSGTXT(16)="    * SDM routine to all appropriate UCIs.         *"
  1.  .S MSGTXT(17)="    *                                              *"
  1.  .S MSGTXT(18)="    ************************************************"
  1.  .D MES^XPDUTL(.MSGTXT)
  1.  .S TMP=$$COPY^SCMSPU2("SCMSPX2","SDM",3)
  1.  ;PCMM installed - SDM should come from SCMSPX1
  1.  I (PATCHED) D
  1.  .S MSGTXT(1)=" "
  1.  .S MSGTXT(2)="    PCMM has been installed.  Will install a version"
  1.  .S MSGTXT(3)="    of routine SDM that has the PCMM changes applied"
  1.  .S MSGTXT(4)="    to it"
  1.  .S MSGTXT(5)=" "
  1.  .S MSGTXT(6)="    MSM sites must copy the SDM routine to all appropriate UCIs"
  1.  .D MES^XPDUTL(.MSGTXT)
  1.  .S TMP=$$COPY^SCMSPU2("SCMSPX1","SDM",3)
  1.  ;Done
  1.  Q