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

SD53P177.m

Go to the documentation of this file. 
  1. SD53P177 ;BP-CIOFO/KEITH - Patch SD*5.3*177 utility routine ; 8/27/99 3:28pm
  1.  ;;5.3;Scheduling;**177,1015**;AUG 13, 1993;Build 21
  1.  ;
  1. ENV ;environment check point.
  1.  ;
  1.  S XPDABORT=""
  1.  D PROGCHK(.XPDABORT) ;checks programmer variables
  1.  D DOMNCHK(.XPDABORT) ;checks Q domain for HL7
  1.  I XPDABORT="" K XPDABORT
  1.  Q
  1.  ;
  1. PRE ;Pre-init
  1.  D DFILE ;Delete entries in file #409.92
  1.  D OPT ;Change name of option SC PCMM GUI WORKSTATI0N
  1.  Q
  1.  ;
  1. DFILE ;Delete file #409.92 entries prior to install
  1.  Q:'$D(^SD(409.92))
  1.  N DIK,DA S DIK="^SD(409.92,",DA=0
  1.  D BMES^XPDUTL("Deleting file #409.92 entries...")
  1.  F  S DA=$O(^SD(409.92,DA)) Q:'DA  D ^DIK
  1.  Q
  1.  ;
  1. OPT ;Rename PCMM GUI option so pre-patch177 clients may not access
  1.  ;post-patch177 server routines.
  1.  ;    From: SC PCMM GUI WORKSTATION
  1.  ;      To: SCMC PCMM GUI WORKSTATION
  1.  ;
  1.  NEW NEW,OLD
  1.  S NEW="SCMC PCMM GUI WORKSTATION"
  1.  S OLD="SC PCMM GUI WORKSTATION"
  1.  ;
  1.  ;Quit if NEW option already exists.
  1.  Q:$$LKOPT^XPDMENU(NEW)
  1.  ;
  1.  ;Rename OLD option.
  1.  D RENAME^XPDMENU(OLD,NEW)
  1.  ;
  1.  D BMES^XPDUTL("Option SC PCMM GUI WORKSTATION renamed to SCMC PCMM GUI WORKSTATION")
  1.  Q
  1.  ;
  1. POST ;Post-init
  1.  D ENMAIN^SCMCCV3(21)  ;Queue the Preceptor Conversion
  1.  D ERMT                ;edit report menu text
  1.  D XREF                ;Reindex 404.43, field .03
  1.  ;                     ; . queue inconsistency report
  1.  D SITE                ;Stuff site number into file 771, field 3
  1.  Q
  1.  ;
  1. ERMT ;Edit report menu text values for GUI selection
  1.  ;
  1.  D BMES^XPDUTL("Editing menu text values for GUI report selection...")
  1.  N SCX,DA,DR,DIE
  1.  S SCX(1)="Pt. List for Team Assignments"
  1.  S SCX(2)="Detailed Patient Assignments"
  1.  S SCX(6)="Summary Listing of Teams"
  1.  S SCX(7)="Team Patient Listing"
  1.  S SCX(8)="Team Member Listing"
  1.  S DIE="^SD(404.92,",DR=".01///^S X=SCX",DA=0
  1.  F  S DA=$O(SCX(DA)) Q:'DA  S SCX=SCX(DA) D ^DIE
  1.  Q
  1.  ;
  1. PROGCHK(XPDABORT) ;checks for necessary programmer variables
  1.  ;
  1.  I '$G(DUZ)!($G(DUZ(0))'="@")!('$G(DT))!($G(U)'="^") DO
  1.  .D BMES^XPDUTL("*****")
  1.  .D MES^XPDUTL("Your programming variables are not set up properly.")
  1.  .D MES^XPDUTL("Installation aborted.")
  1.  .D MES^XPDUTL("*****")
  1.  .S XPDABORT=2
  1.  .Q
  1.  Q
  1.  ;
  1. DOMNCHK(XPDABORT) ;checks for the new Austin q-domain
  1.  ;
  1.  I '$$FIND1^DIC(4.2,,"QX","Q-NPQ.MED.VA.GOV","B") DO
  1.  .D BMES^XPDUTL("*****")
  1.  .D MES^XPDUTL("Installation of this patch requires that the domain")
  1.  .D MES^XPDUTL("Q-NPQ.MED.VA.GOV be defined (XM*999*125).  Installation aborted.")
  1.  .D MES^XPDUTL("*****")
  1.  .S XPDABORT=2
  1.  .K ^TMP("DIERR",$J)
  1.  .Q
  1.  Q
  1.  ;
  1. SITE ;Put local site number in HL7 APPLICATION PARAMETER file (#771).
  1.  NEW FAC,SCERR,SCFDA,SCIENS
  1.  S FAC=+$P($$SITE^VASITE(),"^",3) ;Get facility number
  1.  Q:FAC=""
  1.  S SCIENS=$O(^HL(771,"B","PCMM",""))
  1.  Q:'SCIENS
  1.  S SCIENS=SCIENS_","
  1.  S SCFDA(771,SCIENS,3)=FAC
  1.  D FILE^DIE(,"SCFDA","SCERR")
  1.  Q
  1. XREF ;Queue reindexing of 404.43, field .03.
  1.  Q:$D(^SCPT(404.43,"ACTDFN"))  ;Don't run multiple times.
  1.  ;
  1.  NEW SCDUZ,ZTDESC,ZTDTH,ZTIO,ZTRTN
  1.  S SCDUZ=DUZ
  1.  S ZTDTH=$H
  1.  S ZTIO=""
  1.  S ZTRTN="XREF1^SD53P177"
  1.  S ZTSAVE("SCDUZ")=""
  1.  S ZTDESC="PCMM Patch 177 reindexing"
  1.  D ^%ZTLOAD
  1.  I $D(ZTSK)[0 D  ;
  1.  . D MES^XPDUTL("Reindexing of file 404.43 cancelled!")
  1.  E  D  ;
  1.  . D MES^XPDUTL("Reindexing of file 404.43 queued.")
  1.  . D MES^XPDUTL("Generating mail message with PCMM Inconsistency Report totals.")
  1.  Q
  1. XREF1 ;Reindex 404.43, field .03.
  1.  NEW DIK
  1.  S DIK="^SCPT(404.43,"
  1.  S DIK(1)=".03^ACTDFN2^ACTPC2"
  1.  D ENALL^DIK
  1.  ;
  1.  D MAIL^SCRPV1(SCDUZ) ;Send Brief type Inconsistency Report.
  1.  Q