| 1 | SCMCPST ;ALB/REW - PCMM Post-init ; 4 Feb 1996
 | 
|---|
| 2 |  ;;5.3;Scheduling;**41**;AUG 13, 1993
 | 
|---|
| 3 | EN ;
 | 
|---|
| 4 |  D MESS("PCMM Post-init Actions:","!")
 | 
|---|
| 5 |  N SCUSR,SCVAR
 | 
|---|
| 6 |  N SCLSEQ,SCN,SCESEQ,SCPARM,SCP,SCBEGIN,SCEND,SCINCL,SCDTS
 | 
|---|
| 7 |  IF '$$EXTCHK D  G QTEN
 | 
|---|
| 8 |  .D MESS("...Problem with Package Environment")
 | 
|---|
| 9 |  .D ABORT
 | 
|---|
| 10 |  D MESS("...Environment Ok")
 | 
|---|
| 11 |  IF '$$DEFAULT D  G QTEN
 | 
|---|
| 12 |  .D MESS("...Problem with Setting up default variables")
 | 
|---|
| 13 |  .D ABORT
 | 
|---|
| 14 |  D MESS("...Default setup Ok")
 | 
|---|
| 15 |  IF '$$OKCLEAN D  G QTEN
 | 
|---|
| 16 |  .D MESS("...Problem with Cleanup")
 | 
|---|
| 17 |  .D ABORT
 | 
|---|
| 18 |  D MESS("... Cleanup Ok")
 | 
|---|
| 19 |  D MESS(">>>PCMM Post-init Routine is complete","!!")
 | 
|---|
| 20 | QTEN Q
 | 
|---|
| 21 |  ;
 | 
|---|
| 22 | EXTCHK() ;environment check
 | 
|---|
| 23 |  D MESS(">>> Checking Package Environment","!!")
 | 
|---|
| 24 |  N SCOK
 | 
|---|
| 25 |  S (SCOK,SCUSR)=1
 | 
|---|
| 26 |  S:'$$GLOBCHK SCOK=0
 | 
|---|
| 27 | QTEXT D:'SCOK MESS("Problem with Environment Checker.  Post-init aborted")
 | 
|---|
| 28 |  Q SCOK
 | 
|---|
| 29 |  ;
 | 
|---|
| 30 | DEFAULT() ;setup system defaults
 | 
|---|
| 31 |  N DR,DA,DIE,X,Y,SCOK
 | 
|---|
| 32 |  S SCOK=1
 | 
|---|
| 33 |  D MESS(">>> Setting Default System Settings","!!")
 | 
|---|
| 34 |  D MESS(">>> SCHEDULING PARAMETER FILE (#404.91)","!?4")
 | 
|---|
| 35 |  IF '$D(^SD(404.91,1,0))#2 D
 | 
|---|
| 36 |  .K ^SD(404.91,1)
 | 
|---|
| 37 |  .K DO,DD
 | 
|---|
| 38 |  .S DIC="^SD(404.91,"
 | 
|---|
| 39 |  .S DIC(0)="L"
 | 
|---|
| 40 |  .S X=1
 | 
|---|
| 41 |  .D FILE^DICN
 | 
|---|
| 42 |  D MESS("'USE USR CLASS FUNCTIONALITY?' Field(#801)","!?8")
 | 
|---|
| 43 |  IF $G(SCUSR) D
 | 
|---|
| 44 |  .IF $P($G(^SD(404.91,1,"PCMM")),U,1)="" D
 | 
|---|
| 45 |  ..S DR="801////1;802////1",DA=1,DIE="^SD(404.91," D ^DIE
 | 
|---|
| 46 |  ..D MESS("...Set to 'YES'","?50")
 | 
|---|
| 47 |  .ELSE  D
 | 
|---|
| 48 |  ..D MESS("...Already set - No change","?50")
 | 
|---|
| 49 |  ELSE  D
 | 
|---|
| 50 |  .D MESS("...Needs TIU to be set","?50")
 | 
|---|
| 51 |  .S DR="802////1",DA=1,DIE="^SD(404.91," D ^DIE
 | 
|---|
| 52 |  Q SCOK
 | 
|---|
| 53 | GLOBCHK() ;
 | 
|---|
| 54 |  N SCOK
 | 
|---|
| 55 |  S SCOK=1
 | 
|---|
| 56 |  D MESS(">>> Checking Globals:","!?4")
 | 
|---|
| 57 |  F SCX=1:1 S SCGLOB=$P($T(GLOB+SCX),";;",2) Q:'$L(SCGLOB)  D
 | 
|---|
| 58 |  .S SCARR=$P(SCGLOB,"(",1)
 | 
|---|
| 59 |  .S SCSUB=$P($P(SCGLOB,"(",2),U,1)
 | 
|---|
| 60 |  .S SCVAR=$P(SCGLOB,U,3)
 | 
|---|
| 61 |  .D MESS($P(SCARR_"("_SCSUB,U,2),"!?8")
 | 
|---|
| 62 |  .IF '$D(@SCARR@(SCSUB)) D
 | 
|---|
| 63 |  ..D MESS(" ...Missing","?50")
 | 
|---|
| 64 |  ..S @SCVAR=0
 | 
|---|
| 65 |  .ELSE  D
 | 
|---|
| 66 |  ..D MESS(" ...Present","?50")
 | 
|---|
| 67 | QTGLOB D:'SCOK MESS("Problem with Globals checking")
 | 
|---|
| 68 |  Q SCOK
 | 
|---|
| 69 |  ;
 | 
|---|
| 70 | OKCLEAN() ;
 | 
|---|
| 71 |  D MESS(">>> Cleaning up ^TMP(""SCMC,$J,"" global","!!")
 | 
|---|
| 72 |  N SCOK
 | 
|---|
| 73 |  S SCOK=1
 | 
|---|
| 74 |  K ^TMP("SCMC",$J)
 | 
|---|
| 75 |  Q SCOK
 | 
|---|
| 76 |  ;
 | 
|---|
| 77 | ABORT ;
 | 
|---|
| 78 |  D MESS("After correcting the above mentioned problem(s), you should")
 | 
|---|
| 79 |  D MESS("re-run the PCMM post-init routine by entering the following")
 | 
|---|
| 80 |  D MESS("command at the programmer's prompt:")
 | 
|---|
| 81 |  D MESS("     D EN^SCMCPST")
 | 
|---|
| 82 |  D MESS("")
 | 
|---|
| 83 |  D MESS("Prior to users making team, position, or staff assignments,")
 | 
|---|
| 84 |  D MESS("the post-init may be re-run without any harm.")
 | 
|---|
| 85 |  Q
 | 
|---|
| 86 |  ;
 | 
|---|
| 87 | MESS(TEXT,FORMAT) ;
 | 
|---|
| 88 |  S TEXT=$G(TEXT,"")
 | 
|---|
| 89 |  S FORMAT=$G(FORMAT,"!")
 | 
|---|
| 90 |  D EN^DDIOL(TEXT,"",FORMAT)
 | 
|---|
| 91 |  Q
 | 
|---|
| 92 |  ;
 | 
|---|
| 93 | GLOB ;
 | 
|---|
| 94 |  ;;^USR(8930.3^SCUSR
 | 
|---|
| 95 |  ;;^USR(8930^SCUSR
 | 
|---|
| 96 |  ;
 | 
|---|
| 97 | LTRRT ; - to be used later if a/s isn't distributed with pcmm
 | 
|---|
| 98 |  ;;USRPROV^1.0T7^Authorization/Subscription^^Feb 15, 1996^SCUSR
 | 
|---|
| 99 | LTRGLB ;
 | 
|---|