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