SCMCPST ;ALB/REW - PCMM Post-init ; 4 Feb 1996
;;5.3;Scheduling;**41,1015**;AUG 13, 1993;Build 21
EN ;
D MESS("PCMM Post-init Actions:","!")
N SCUSR,SCVAR
N SCLSEQ,SCN,SCESEQ,SCPARM,SCP,SCBEGIN,SCEND,SCINCL,SCDTS
IF '$$EXTCHK D G QTEN
.D MESS("...Problem with Package Environment")
.D ABORT
D MESS("...Environment Ok")
IF '$$DEFAULT D G QTEN
.D MESS("...Problem with Setting up default variables")
.D ABORT
D MESS("...Default setup Ok")
IF '$$OKCLEAN D G QTEN
.D MESS("...Problem with Cleanup")
.D ABORT
D MESS("... Cleanup Ok")
D MESS(">>>PCMM Post-init Routine is complete","!!")
QTEN Q
;
EXTCHK() ;environment check
D MESS(">>> Checking Package Environment","!!")
N SCOK
S (SCOK,SCUSR)=1
S:'$$GLOBCHK SCOK=0
QTEXT D:'SCOK MESS("Problem with Environment Checker. Post-init aborted")
Q SCOK
;
DEFAULT() ;setup system defaults
N DR,DA,DIE,X,Y,SCOK
S SCOK=1
D MESS(">>> Setting Default System Settings","!!")
D MESS(">>> SCHEDULING PARAMETER FILE (#404.91)","!?4")
IF '$D(^SD(404.91,1,0))#2 D
.K ^SD(404.91,1)
.K DO,DD
.S DIC="^SD(404.91,"
.S DIC(0)="L"
.S X=1
.D FILE^DICN
D MESS("'USE USR CLASS FUNCTIONALITY?' Field(#801)","!?8")
IF $G(SCUSR) D
.IF $P($G(^SD(404.91,1,"PCMM")),U,1)="" D
..S DR="801////1;802////1",DA=1,DIE="^SD(404.91," D ^DIE
..D MESS("...Set to 'YES'","?50")
.ELSE D
..D MESS("...Already set - No change","?50")
ELSE D
.D MESS("...Needs TIU to be set","?50")
.S DR="802////1",DA=1,DIE="^SD(404.91," D ^DIE
Q SCOK
GLOBCHK() ;
N SCOK
S SCOK=1
D MESS(">>> Checking Globals:","!?4")
F SCX=1:1 S SCGLOB=$P($T(GLOB+SCX),";;",2) Q:'$L(SCGLOB) D
.S SCARR=$P(SCGLOB,"(",1)
.S SCSUB=$P($P(SCGLOB,"(",2),U,1)
.S SCVAR=$P(SCGLOB,U,3)
.D MESS($P(SCARR_"("_SCSUB,U,2),"!?8")
.IF '$D(@SCARR@(SCSUB)) D
..D MESS(" ...Missing","?50")
..S @SCVAR=0
.ELSE D
..D MESS(" ...Present","?50")
QTGLOB D:'SCOK MESS("Problem with Globals checking")
Q SCOK
;
OKCLEAN() ;
D MESS(">>> Cleaning up ^TMP(""SCMC,$J,"" global","!!")
N SCOK
S SCOK=1
K ^TMP("SCMC",$J)
Q SCOK
;
ABORT ;
D MESS("After correcting the above mentioned problem(s), you should")
D MESS("re-run the PCMM post-init routine by entering the following")
D MESS("command at the programmer's prompt:")
D MESS(" D EN^SCMCPST")
D MESS("")
D MESS("Prior to users making team, position, or staff assignments,")
D MESS("the post-init may be re-run without any harm.")
Q
;
MESS(TEXT,FORMAT) ;
S TEXT=$G(TEXT,"")
S FORMAT=$G(FORMAT,"!")
D EN^DDIOL(TEXT,"",FORMAT)
Q
;
GLOB ;
;;^USR(8930.3^SCUSR
;;^USR(8930^SCUSR
;
LTRRT ; - to be used later if a/s isn't distributed with pcmm
;;USRPROV^1.0T7^Authorization/Subscription^^Feb 15, 1996^SCUSR
LTRGLB ;
SCMCPST ;ALB/REW - PCMM Post-init ; 4 Feb 1996
+1 ;;5.3;Scheduling;**41,1015**;AUG 13, 1993;Build 21
EN ;
+1 DO MESS("PCMM Post-init Actions:","!")
+2 NEW SCUSR,SCVAR
+3 NEW SCLSEQ,SCN,SCESEQ,SCPARM,SCP,SCBEGIN,SCEND,SCINCL,SCDTS
+4 IF '$$EXTCHK
Begin DoDot:1
+5 DO MESS("...Problem with Package Environment")
+6 DO ABORT
End DoDot:1
GOTO QTEN
+7 DO MESS("...Environment Ok")
+8 IF '$$DEFAULT
Begin DoDot:1
+9 DO MESS("...Problem with Setting up default variables")
+10 DO ABORT
End DoDot:1
GOTO QTEN
+11 DO MESS("...Default setup Ok")
+12 IF '$$OKCLEAN
Begin DoDot:1
+13 DO MESS("...Problem with Cleanup")
+14 DO ABORT
End DoDot:1
GOTO QTEN
+15 DO MESS("... Cleanup Ok")
+16 DO MESS(">>>PCMM Post-init Routine is complete","!!")
QTEN QUIT
+1 ;
EXTCHK() ;environment check
+1 DO MESS(">>> Checking Package Environment","!!")
+2 NEW SCOK
+3 SET (SCOK,SCUSR)=1
+4 IF '$$GLOBCHK
SET SCOK=0
QTEXT IF 'SCOK
DO MESS("Problem with Environment Checker. Post-init aborted")
+1 QUIT SCOK
+2 ;
DEFAULT() ;setup system defaults
+1 NEW DR,DA,DIE,X,Y,SCOK
+2 SET SCOK=1
+3 DO MESS(">>> Setting Default System Settings","!!")
+4 DO MESS(">>> SCHEDULING PARAMETER FILE (#404.91)","!?4")
+5 IF '$DATA(^SD(404.91,1,0))#2
Begin DoDot:1
+6 KILL ^SD(404.91,1)
+7 KILL DO,DD
+8 SET DIC="^SD(404.91,"
+9 SET DIC(0)="L"
+10 SET X=1
+11 DO FILE^DICN
End DoDot:1
+12 DO MESS("'USE USR CLASS FUNCTIONALITY?' Field(#801)","!?8")
+13 IF $GET(SCUSR)
Begin DoDot:1
+14 IF $PIECE($GET(^SD(404.91,1,"PCMM")),U,1)=""
Begin DoDot:2
+15 SET DR="801////1;802////1"
SET DA=1
SET DIE="^SD(404.91,"
DO ^DIE
+16 DO MESS("...Set to 'YES'","?50")
End DoDot:2
+17 IF '$TEST
Begin DoDot:2
+18 DO MESS("...Already set - No change","?50")
End DoDot:2
End DoDot:1
+19 IF '$TEST
Begin DoDot:1
+20 DO MESS("...Needs TIU to be set","?50")
+21 SET DR="802////1"
SET DA=1
SET DIE="^SD(404.91,"
DO ^DIE
End DoDot:1
+22 QUIT SCOK
GLOBCHK() ;
+1 NEW SCOK
+2 SET SCOK=1
+3 DO MESS(">>> Checking Globals:","!?4")
+4 FOR SCX=1:1
SET SCGLOB=$PIECE($TEXT(GLOB+SCX),";;",2)
IF '$LENGTH(SCGLOB)
QUIT
Begin DoDot:1
+5 SET SCARR=$PIECE(SCGLOB,"(",1)
+6 SET SCSUB=$PIECE($PIECE(SCGLOB,"(",2),U,1)
+7 SET SCVAR=$PIECE(SCGLOB,U,3)
+8 DO MESS($PIECE(SCARR_"("_SCSUB,U,2),"!?8")
+9 IF '$DATA(@SCARR@(SCSUB))
Begin DoDot:2
+10 DO MESS(" ...Missing","?50")
+11 SET @SCVAR=0
End DoDot:2
+12 IF '$TEST
Begin DoDot:2
+13 DO MESS(" ...Present","?50")
End DoDot:2
End DoDot:1
QTGLOB IF 'SCOK
DO MESS("Problem with Globals checking")
+1 QUIT SCOK
+2 ;
OKCLEAN() ;
+1 DO MESS(">>> Cleaning up ^TMP(""SCMC,$J,"" global","!!")
+2 NEW SCOK
+3 SET SCOK=1
+4 KILL ^TMP("SCMC",$JOB)
+5 QUIT SCOK
+6 ;
ABORT ;
+1 DO MESS("After correcting the above mentioned problem(s), you should")
+2 DO MESS("re-run the PCMM post-init routine by entering the following")
+3 DO MESS("command at the programmer's prompt:")
+4 DO MESS(" D EN^SCMCPST")
+5 DO MESS("")
+6 DO MESS("Prior to users making team, position, or staff assignments,")
+7 DO MESS("the post-init may be re-run without any harm.")
+8 QUIT
+9 ;
MESS(TEXT,FORMAT) ;
+1 SET TEXT=$GET(TEXT,"")
+2 SET FORMAT=$GET(FORMAT,"!")
+3 DO EN^DDIOL(TEXT,"",FORMAT)
+4 QUIT
+5 ;
GLOB ;
+1 ;;^USR(8930.3^SCUSR
+2 ;;^USR(8930^SCUSR
+3 ;
LTRRT ; - to be used later if a/s isn't distributed with pcmm
+1 ;;USRPROV^1.0T7^Authorization/Subscription^^Feb 15, 1996^SCUSR
LTRGLB ;
