- SROPOST ;B'HAM ISC/MAM - POST INIT FOR V3 ; 16 JAN 1990 10:35 AM
- ;;3.0; Surgery ;**6**;24 Jun 93
- S SRVER=1,SRSITE=$O(^SRO(133,0)) I 'SRSITE D NEW^SROPOST2
- I SRSITE S Z=$P(^SRO(133,SRSITE,0),"^",3) I Z["3.0" S SRVER=0
- I SRVER D SEC
- I SRVER K ^SRF("AC"),^SRF("ADT"),DIK S DIK="^SRF(",DIK(1)=".09^AC^ADT" D ENALL^DIK K DIK
- I SRVER S DIK="^SRF(",DIK(1)="11^AMM" D ENALL^DIK K DIK
- ADDSUB 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
- D ^SROPOST0,^SROPOST1,^SROPOST2
- I 'SRVER K DIK S DIK="^SRO(137.45,",DIK(1)=".01^B1" D ENALL^DIK K DIK
- S X=0 F I=0:0 S X=$O(^SRO(133,X)) Q:'X S $P(^SRO(133,X,0),"^",3)="3.0"
- W !!,"Installation of Surgery Version 3.0 is finished.",! K SRVER,SRSITE,SRINST
- Q
- SEC W !!,"Updating security keys based on User Title for use with the Anestesia AMIS..."
- 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
- I $O(^TMP("SR CORRUPT",$J,0)) D CORRUPT
- D ^SRONIT
- K CHECK,DA,DD,DIC,DIE,DO,MOE,SHEMP,SRK7
- Q
- KEY ; update security keys
- I '$D(^VA(200,SHEMP,0)) S ^TMP("SR CORRUPT",$J,SHEMP)="" Q
- 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)
- S CHECK=0 I MOE["NURSE ANE" S CURLEY="SR NURSE ANESTHETIST",CHECK=1
- I MOE["ANESTHESIOLOGIST" S CURLEY="SR ANESTHESIOLOGIST",CHECK=1
- I MOE["PHYSICIAN" S CURLEY="SR SURGEON",CHECK=1
- I CHECK,$D(^XUSEC(CURLEY,SHEMP)) S CHECK=0
- I 'CHECK Q
- S MOE=$O(^DIC(19.1,"B",CURLEY,0)) I 'MOE Q
- I SRK7 D K7 Q
- I '$D(^DIC(19.1,MOE,2,0)) S ^DIC(19.1,MOE,2,0)="^19.12^^"
- 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
- Q
- K7 ; update key if Kernel 7 or greater
- K DA,DIC I '$D(^VA(200,SHEMP,51,0)) S ^VA(200,SHEMP,51,0)="^"_$P(^DD(200,51,0),"^",2)
- 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
- Q
- CORRUPT ; send message regarding corrupted entries in ^VA(200
- S XMDUZ="SURGERY POST-INIT",XMSUB="Missing Zero Nodes in NEW PERSON file (200)",XMTEXT="CURLEY(",XMY(DUZ)=""
- 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)=" "
- 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 "
- 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"
- S CURLEY(8)="please contact your local ISC.",CURLEY(9)=" ",CURLEY(10)="The following entries in ^VA(200) are missing the zero node."
- 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
- D ^XMD K CURLEY,X
- Q
- DAY ; add days of the week that do not exist
- Q:SRROOM=0
- 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
- Q
- SROPOST ;B'HAM ISC/MAM - POST INIT FOR V3 ; 16 JAN 1990 10:35 AM
- +1 ;;3.0; Surgery ;**6**;24 Jun 93
- +2 SET SRVER=1
- SET SRSITE=$ORDER(^SRO(133,0))
- IF 'SRSITE
- DO NEW^SROPOST2
- +3 IF SRSITE
- SET Z=$PIECE(^SRO(133,SRSITE,0),"^",3)
- IF Z["3.0"
- SET SRVER=0
- +4 IF SRVER
- DO SEC
- +5 IF SRVER
- KILL ^SRF("AC"),^SRF("ADT"),DIK
- SET DIK="^SRF("
- SET DIK(1)=".09^AC^ADT"
- DO ENALL^DIK
- KILL DIK
- +6 IF SRVER
- SET DIK="^SRF("
- SET DIK(1)="11^AMM"
- DO ENALL^DIK
- KILL DIK
- ADDSUB IF SRVER
- FOR SRROOM=0:0
- SET SRROOM=$ORDER(^SRS(SRROOM))
- IF SRROOM'>0
- QUIT
- IF $PIECE($GET(^SRS(SRROOM,4,0)),"^",2)=131.177
- KILL ^SRS(SRROOM,4)
- IF '$DATA(^SRS(SRROOM,4,0))
- SET ^SRS(SRROOM,4,0)="^131.711S^^"
- DO DAY
- +1 DO ^SROPOST0
- DO ^SROPOST1
- DO ^SROPOST2
- +2 IF 'SRVER
- KILL DIK
- SET DIK="^SRO(137.45,"
- SET DIK(1)=".01^B1"
- DO ENALL^DIK
- KILL DIK
- +3 SET X=0
- FOR I=0:0
- SET X=$ORDER(^SRO(133,X))
- IF 'X
- QUIT
- SET $PIECE(^SRO(133,X,0),"^",3)="3.0"
- +4 WRITE !!,"Installation of Surgery Version 3.0 is finished.",!
- KILL SRVER,SRSITE,SRINST
- +5 QUIT
- SEC WRITE !!,"Updating security keys based on User Title for use with the Anestesia AMIS..."
- +1 KILL ^TMP("SR CORRUPT",$JOB)
- SET SRK7=$SELECT($DATA(^DD(19.12)):0,1:1)
- SET SHEMP=0
- FOR
- SET SHEMP=$ORDER(^VA(200,SHEMP))
- IF 'SHEMP
- QUIT
- DO KEY
- +2 IF $ORDER(^TMP("SR CORRUPT",$JOB,0))
- DO CORRUPT
- +3 DO ^SRONIT
- +4 KILL CHECK,DA,DD,DIC,DIE,DO,MOE,SHEMP,SRK7
- +5 QUIT
- KEY ; update security keys
- +1 IF '$DATA(^VA(200,SHEMP,0))
- SET ^TMP("SR CORRUPT",$JOB,SHEMP)=""
- QUIT
- +2 SET X=$PIECE(^VA(200,SHEMP,0),"^",9)
- IF 'X
- QUIT
- IF '$DATA(^DIC(3.1,X,0))
- QUIT
- SET DIC(0)="N"
- SET DIC=3.1
- DO ^DIC
- KILL DIC
- IF Y<0
- QUIT
- SET MOE=$PIECE(Y,"^",2)
- +3 SET CHECK=0
- IF MOE["NURSE ANE"
- SET CURLEY="SR NURSE ANESTHETIST"
- SET CHECK=1
- +4 IF MOE["ANESTHESIOLOGIST"
- SET CURLEY="SR ANESTHESIOLOGIST"
- SET CHECK=1
- +5 IF MOE["PHYSICIAN"
- SET CURLEY="SR SURGEON"
- SET CHECK=1
- +6 IF CHECK
- IF $DATA(^XUSEC(CURLEY,SHEMP))
- SET CHECK=0
- +7 IF 'CHECK
- QUIT
- +8 SET MOE=$ORDER(^DIC(19.1,"B",CURLEY,0))
- IF 'MOE
- QUIT
- +9 IF SRK7
- DO K7
- QUIT
- +10 IF '$DATA(^DIC(19.1,MOE,2,0))
- SET ^DIC(19.1,MOE,2,0)="^19.12^^"
- +11 KILL DA,DIC,DINUM,DD,DO
- SET DIC(0)="L"
- SET DLAYGO=19.12
- SET DIC="^DIC(19.1,"_MOE_",2,"
- SET X=SHEMP
- SET DA(1)=MOE
- DO FILE^DICN
- KILL DIC,DLAYGO,Y
- +12 QUIT
- K7 ; update key if Kernel 7 or greater
- +1 KILL DA,DIC
- IF '$DATA(^VA(200,SHEMP,51,0))
- SET ^VA(200,SHEMP,51,0)="^"_$PIECE(^DD(200,51,0),"^",2)
- +2 SET DA(1)=SHEMP
- SET DIC="^VA(200,"_SHEMP_",51,"
- SET DIC(0)="LM"
- SET DLAYGO=200.051
- SET (DINUM,X)=MOE
- DO FILE^DICN
- KILL DIC,DLAYGO,Y
- +3 QUIT
- CORRUPT ; send message regarding corrupted entries in ^VA(200
- +1 SET XMDUZ="SURGERY POST-INIT"
- SET XMSUB="Missing Zero Nodes in NEW PERSON file (200)"
- SET XMTEXT="CURLEY("
- SET XMY(DUZ)=""
- +2 SET CURLEY(1)="The information provided in this message was determined by the post-init"
- SET CURLEY(2)="routine for Surgery Version 3.0."
- SET CURLEY(3)=" "
- +3 SET CURLEY(4)="The following list contains entries in the NEW PERSON file (200) that do not"
- SET CURLEY(5)="have zero nodes. The cause of this corruption cannot be determined by this "
- +4 SET CURLEY(6)="process. You should review the global and kill any nodes that do not have a"
- SET CURLEY(7)="zero node associated with them. If you are not sure how to clean up this file"
- +5 SET CURLEY(8)="please contact your local ISC."
- SET CURLEY(9)=" "
- SET CURLEY(10)="The following entries in ^VA(200) are missing the zero node."
- +6 SET CNT=10
- SET X=0
- FOR
- SET X=$ORDER(^TMP("SR CORRUPT",$JOB,X))
- IF 'X
- QUIT
- SET CNT=CNT+1
- SET CURLEY(CNT)=" Internal Entry Number: "_X
- +7 DO ^XMD
- KILL CURLEY,X
- +8 QUIT
- DAY ; add days of the week that do not exist
- +1 IF SRROOM=0
- QUIT
- +2 FOR SRDAY=0:1:6
- IF '$DATA(^SRS(SRROOM,4,"B",SRDAY))
- KILL DD,DO,DIC
- SET DIC="^SRS("_SRROOM_",4,"
- SET DIC(0)="LMZ"
- SET DA(1)=SRROOM
- SET X=SRDAY
- DO FILE^DICN
- KILL DD,DO,DIC
- +3 QUIT
