| [613] | 1 | SROSTAFF ;B'HAM ISC/MAM - UPDATE STAFF SURGEON INFO ; 2 APR 1992 1:00 pm
|
|---|
| 2 | ;;3.0; Surgery ;**18**;24 Jun 93
|
|---|
| 3 | S KEY=$O(^DIC(19.1,"B","SR STAFF SURGEON",0))
|
|---|
| 4 | S SRSOUT=0 W @IOF,! K DIC S DIC=200,DIC(0)="QEAMZ",DIC("A")="Update Information for which Surgeon: ",DIC("S")="I $L($P(^(0),U,3))" D ^DIC I Y<0 S SRSOUT=1 G END
|
|---|
| 5 | S SRSDOC=+Y,SRDOC=$P(Y(0),"^")
|
|---|
| 6 | S SRDD=$S($D(^DD(19.12)):"OLD",1:"NEW")
|
|---|
| 7 | I $D(^XUSEC("SR STAFF SURGEON",SRSDOC)) D EXISTS G END
|
|---|
| 8 | ASK W !!,"Do you want to designate this person as a 'Staff Surgeon' ? YES// " R SRYN:DTIME I '$T!(SRYN["^") S SRSOUT=1 G END
|
|---|
| 9 | S SRYN=$E(SRYN) I "YyNn"'[SRYN W !!,"Enter 'YES' if this person is a Staff Surgeon, or 'NO' to quit this option." G ASK
|
|---|
| 10 | I "Yy"'[SRYN S SRSOUT=1 G END
|
|---|
| 11 | D:SRDD="NEW" K7 I SRDD="OLD" D PREK7
|
|---|
| 12 | END I 'SRSOUT W !!,"Press RETURN to continue " R X:DTIME
|
|---|
| 13 | D ^SRSKILL W @IOF
|
|---|
| 14 | Q
|
|---|
| 15 | K7 ; update key if KERNEL 7 or greater
|
|---|
| 16 | K DA,DIC I '$D(^VA(200,SRSDOC,51,0)) S ^VA(200,SRSDOC,51,0)="^"_$P(^DD(200,51,0),"^",2)
|
|---|
| 17 | S DA(1)=SRSDOC,DIC="^VA(200,"_SRSDOC_",51,",DIC(0)="LM",DLAYGO=200.051,(DINUM,X)=KEY D FILE^DICN
|
|---|
| 18 | W !!,SRDOC_" is now designated as a staff surgeon."
|
|---|
| 19 | Q
|
|---|
| 20 | PREK7 ; update key if KERNEL 6.5 or lower
|
|---|
| 21 | K DA,DIC I '$D(^DIC(19.1,KEY,2,0)) S ^DIC(19.1,KEY,2,0)="^"_$P(^DD(19.1,2,0),"^",2)
|
|---|
| 22 | S DA(1)=KEY,DIC="^DIC(19.1,"_KEY_",2,",DIC(0)="LM",DLAYGO=19.12,X=SRSDOC D FILE^DICN
|
|---|
| 23 | W !!,SRDOC_" is now designated as a staff surgeon."
|
|---|
| 24 | Q
|
|---|
| 25 | EXISTS W !!,"This person is already designated as a staff surgeon. Do you want to remove",!,"that designation ? NO// " R SRYN:DTIME I '$T!("^"[SRYN) S SRSOUT=1 Q
|
|---|
| 26 | S SRYN=$E(SRYN) I "NnYy"'[SRYN W !!,"Enter 'YES' to remove the key used to designate this person as a staff",!,"surgeon, or 'NO' to leave this designation unchanged." G EXISTS
|
|---|
| 27 | I "Nn"[SRYN S SRSOUT=1 Q
|
|---|
| 28 | I SRDD="NEW" D KILLK7 Q
|
|---|
| 29 | K SRENTRY S X=0 F S X=$O(^DIC(19.1,KEY,2,X)) Q:'X!($D(SRENTRY)) I $P(^DIC(19.1,KEY,2,X,0),"^")=SRSDOC S SRENTRY=X
|
|---|
| 30 | K DIK S DA=SRENTRY,DA(1)=KEY,DIK="^DIC(19.1,"_DA(1)_",2," W !!,"Removing key designating "_SRDOC_" as a staff surgeon..." D ^DIK
|
|---|
| 31 | Q
|
|---|
| 32 | KILLK7 ; remove key if KERNEL 7 or greater
|
|---|
| 33 | K DIK,DA S DA=KEY,DA(1)=SRSDOC,DIK="^VA(200,"_DA(1)_",51," W !!,"Removing key designating "_SRDOC_" as a staff surgeon..." D ^DIK
|
|---|
| 34 | Q
|
|---|
