SCMCPST.m

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    ;