source: WorldVistAEHR/trunk/r/SURGERY-SR/SROPOST.m@ 691

Last change on this file since 691 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.1 KB
RevLine 
[613]1SROPOST ;B'HAM ISC/MAM - POST INIT FOR V3 ; 16 JAN 1990 10:35 AM
2 ;;3.0; Surgery ;**6**;24 Jun 93
3 S SRVER=1,SRSITE=$O(^SRO(133,0)) I 'SRSITE D NEW^SROPOST2
4 I SRSITE S Z=$P(^SRO(133,SRSITE,0),"^",3) I Z["3.0" S SRVER=0
5 I SRVER D SEC
6 I SRVER K ^SRF("AC"),^SRF("ADT"),DIK S DIK="^SRF(",DIK(1)=".09^AC^ADT" D ENALL^DIK K DIK
7 I SRVER S DIK="^SRF(",DIK(1)="11^AMM" D ENALL^DIK K DIK
8ADDSUB I SRVER F SRROOM=0:0 S SRROOM=$O(^SRS(SRROOM)) Q:SRROOM'>0 K:$P($G(^SRS(SRROOM,4,0)),"^",2)=131.177 ^SRS(SRROOM,4) S:'$D(^SRS(SRROOM,4,0)) ^SRS(SRROOM,4,0)="^131.711S^^" D DAY
9 D ^SROPOST0,^SROPOST1,^SROPOST2
10 I 'SRVER K DIK S DIK="^SRO(137.45,",DIK(1)=".01^B1" D ENALL^DIK K DIK
11 S X=0 F I=0:0 S X=$O(^SRO(133,X)) Q:'X S $P(^SRO(133,X,0),"^",3)="3.0"
12 W !!,"Installation of Surgery Version 3.0 is finished.",! K SRVER,SRSITE,SRINST
13 Q
14SEC W !!,"Updating security keys based on User Title for use with the Anestesia AMIS..."
15 K ^TMP("SR CORRUPT",$J) S SRK7=$S($D(^DD(19.12)):0,1:1),SHEMP=0 F S SHEMP=$O(^VA(200,SHEMP)) Q:'SHEMP D KEY
16 I $O(^TMP("SR CORRUPT",$J,0)) D CORRUPT
17 D ^SRONIT
18 K CHECK,DA,DD,DIC,DIE,DO,MOE,SHEMP,SRK7
19 Q
20KEY ; update security keys
21 I '$D(^VA(200,SHEMP,0)) S ^TMP("SR CORRUPT",$J,SHEMP)="" Q
22 S X=$P(^VA(200,SHEMP,0),"^",9) Q:'X Q:'$D(^DIC(3.1,X,0)) S DIC(0)="N",DIC=3.1 D ^DIC K DIC Q:Y<0 S MOE=$P(Y,"^",2)
23 S CHECK=0 I MOE["NURSE ANE" S CURLEY="SR NURSE ANESTHETIST",CHECK=1
24 I MOE["ANESTHESIOLOGIST" S CURLEY="SR ANESTHESIOLOGIST",CHECK=1
25 I MOE["PHYSICIAN" S CURLEY="SR SURGEON",CHECK=1
26 I CHECK,$D(^XUSEC(CURLEY,SHEMP)) S CHECK=0
27 I 'CHECK Q
28 S MOE=$O(^DIC(19.1,"B",CURLEY,0)) I 'MOE Q
29 I SRK7 D K7 Q
30 I '$D(^DIC(19.1,MOE,2,0)) S ^DIC(19.1,MOE,2,0)="^19.12^^"
31 K DA,DIC,DINUM,DD,DO S DIC(0)="L",DLAYGO=19.12,DIC="^DIC(19.1,"_MOE_",2,",X=SHEMP,DA(1)=MOE D FILE^DICN K DIC,DLAYGO,Y
32 Q
33K7 ; update key if Kernel 7 or greater
34 K DA,DIC I '$D(^VA(200,SHEMP,51,0)) S ^VA(200,SHEMP,51,0)="^"_$P(^DD(200,51,0),"^",2)
35 S DA(1)=SHEMP,DIC="^VA(200,"_SHEMP_",51,",DIC(0)="LM",DLAYGO=200.051,(DINUM,X)=MOE D FILE^DICN K DIC,DLAYGO,Y
36 Q
37CORRUPT ; send message regarding corrupted entries in ^VA(200
38 S XMDUZ="SURGERY POST-INIT",XMSUB="Missing Zero Nodes in NEW PERSON file (200)",XMTEXT="CURLEY(",XMY(DUZ)=""
39 S CURLEY(1)="The information provided in this message was determined by the post-init",CURLEY(2)="routine for Surgery Version 3.0.",CURLEY(3)=" "
40 S CURLEY(4)="The following list contains entries in the NEW PERSON file (200) that do not",CURLEY(5)="have zero nodes. The cause of this corruption cannot be determined by this "
41 S CURLEY(6)="process. You should review the global and kill any nodes that do not have a",CURLEY(7)="zero node associated with them. If you are not sure how to clean up this file"
42 S CURLEY(8)="please contact your local ISC.",CURLEY(9)=" ",CURLEY(10)="The following entries in ^VA(200) are missing the zero node."
43 S CNT=10,X=0 F S X=$O(^TMP("SR CORRUPT",$J,X)) Q:'X S CNT=CNT+1,CURLEY(CNT)=" Internal Entry Number: "_X
44 D ^XMD K CURLEY,X
45 Q
46DAY ; add days of the week that do not exist
47 Q:SRROOM=0
48 F SRDAY=0:1:6 I '$D(^SRS(SRROOM,4,"B",SRDAY)) K DD,DO,DIC S DIC="^SRS("_SRROOM_",4,",DIC(0)="LMZ",DA(1)=SRROOM,X=SRDAY D FILE^DICN K DD,DO,DIC
49 Q
Note: See TracBrowser for help on using the repository browser.