SROSTAFF.m

SROSTAFF ;B'HAM ISC/MAM - UPDATE STAFF SURGEON INFO ; 2 APR 1992  1:00 pm

 ;;3.0; Surgery ;**18**;24 Jun 93

 S KEY=$O(^DIC(19.1,"B","SR STAFF SURGEON",0))

 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

 S SRSDOC=+Y,SRDOC=$P(Y(0),"^")

 S SRDD=$S($D(^DD(19.12)):"OLD",1:"NEW")

 I $D(^XUSEC("SR STAFF SURGEON",SRSDOC)) D EXISTS G END

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

 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

 I "Yy"'[SRYN S SRSOUT=1 G END

 D:SRDD="NEW" K7 I SRDD="OLD" D PREK7

END I 'SRSOUT W !!,"Press RETURN to continue  " R X:DTIME

 D ^SRSKILL W @IOF

 Q

K7 ; update key if KERNEL 7 or greater

 K DA,DIC I '$D(^VA(200,SRSDOC,51,0)) S ^VA(200,SRSDOC,51,0)="^"_$P(^DD(200,51,0),"^",2)

 S DA(1)=SRSDOC,DIC="^VA(200,"_SRSDOC_",51,",DIC(0)="LM",DLAYGO=200.051,(DINUM,X)=KEY D FILE^DICN

 W !!,SRDOC_" is now designated as a staff surgeon."

 Q

PREK7 ; update key if KERNEL 6.5 or lower

 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)

 S DA(1)=KEY,DIC="^DIC(19.1,"_KEY_",2,",DIC(0)="LM",DLAYGO=19.12,X=SRSDOC D FILE^DICN

 W !!,SRDOC_" is now designated as a staff surgeon."

 Q

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

 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

 I "Nn"[SRYN S SRSOUT=1 Q

 I SRDD="NEW" D KILLK7 Q

 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

 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

 Q

KILLK7 ; remove key if KERNEL 7 or greater

 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

 Q

SROSTAFF  ;B'HAM ISC/MAM - UPDATE STAFF SURGEON INFO ; 2 APR 1992  1:00 pm

 +1       ;;3.0; Surgery ;**18**;24 Jun 93

 +2        SET KEY=$ORDER(^DIC(19.1,"B","SR STAFF SURGEON",0))

 +3        SET SRSOUT=0

           WRITE @IOF,!

           KILL DIC

           SET DIC=200

           SET DIC(0)="QEAMZ"

           SET DIC("A")="Update Information for which Surgeon: "

           SET DIC("S")="I $L($P(^(0),U,3))"

           DO ^DIC

           IF Y<0

               SET SRSOUT=1

               GOTO END

 +4        SET SRSDOC=+Y

           SET SRDOC=$PIECE(Y(0),"^")

 +5        SET SRDD=$SELECT($DATA(^DD(19.12)):"OLD",1:"NEW")

 +6        IF $DATA(^XUSEC("SR STAFF SURGEON",SRSDOC))

               DO EXISTS

               GOTO END

ASK        WRITE !!,"Do you want to designate this person as a 'Staff Surgeon' ? YES//  "

           READ SRYN:DTIME

           IF '$TEST!(SRYN["^")

               SET SRSOUT=1

               GOTO END

 +1        SET SRYN=$EXTRACT(SRYN)

           IF "YyNn"'[SRYN

               WRITE !!,"Enter 'YES' if this person is a Staff Surgeon, or 'NO' to quit this option."

               GOTO ASK

 +2        IF "Yy"'[SRYN

               SET SRSOUT=1

               GOTO END

 +3        IF SRDD="NEW"

               DO K7

           IF SRDD="OLD"

               DO PREK7

END        IF 'SRSOUT

               WRITE !!,"Press RETURN to continue  "

               READ X:DTIME

 +1        DO ^SRSKILL

           WRITE @IOF

 +2        QUIT 

K7        ; update key if KERNEL 7 or greater

 +1        KILL DA,DIC

           IF '$DATA(^VA(200,SRSDOC,51,0))

               SET ^VA(200,SRSDOC,51,0)="^"_$PIECE(^DD(200,51,0),"^",2)

 +2        SET DA(1)=SRSDOC

           SET DIC="^VA(200,"_SRSDOC_",51,"

           SET DIC(0)="LM"

           SET DLAYGO=200.051

           SET (DINUM,X)=KEY

           DO FILE^DICN

 +3        WRITE !!,SRDOC_" is now designated as a staff surgeon."

 +4        QUIT 

PREK7     ; update key if KERNEL 6.5 or lower

 +1        KILL DA,DIC

           IF '$DATA(^DIC(19.1,KEY,2,0))

               SET ^DIC(19.1,KEY,2,0)="^"_$PIECE(^DD(19.1,2,0),"^",2)

 +2        SET DA(1)=KEY

           SET DIC="^DIC(19.1,"_KEY_",2,"

           SET DIC(0)="LM"

           SET DLAYGO=19.12

           SET X=SRSDOC

           DO FILE^DICN

 +3        WRITE !!,SRDOC_" is now designated as a staff surgeon."

 +4        QUIT 

EXISTS     WRITE !!,"This person is already designated as a staff surgeon.  Do you want to remove",!,"that designation ?  NO//  "

           READ SRYN:DTIME

           IF '$TEST!("^"[SRYN)

               SET SRSOUT=1

               QUIT 

 +1        SET SRYN=$EXTRACT(SRYN)

           IF "NnYy"'[SRYN

               WRITE !!,"Enter 'YES' to remove the key used to designate this person as a staff",!,"surgeon, or 'NO' to leave this designation unchanged."

               GOTO EXISTS

 +2        IF "Nn"[SRYN

               SET SRSOUT=1

               QUIT 

 +3        IF SRDD="NEW"

               DO KILLK7

               QUIT 

 +4        KILL SRENTRY

           SET X=0

           FOR 

               SET X=$ORDER(^DIC(19.1,KEY,2,X))

               IF 'X!($DATA(SRENTRY))

                   QUIT 

               IF $PIECE(^DIC(19.1,KEY,2,X,0),"^")=SRSDOC

                   SET SRENTRY=X

 +5        KILL DIK

           SET DA=SRENTRY

           SET DA(1)=KEY

           SET DIK="^DIC(19.1,"_DA(1)_",2,"

           WRITE !!,"Removing key designating "_SRDOC_" as a staff surgeon..."

           DO ^DIK

 +6        QUIT 

KILLK7    ; remove key if KERNEL 7 or greater

 +1        KILL DIK,DA

           SET DA=KEY

           SET DA(1)=SRSDOC

           SET DIK="^VA(200,"_DA(1)_",51,"

           WRITE !!,"Removing key designating "_SRDOC_" as a staff surgeon..."

           DO ^DIK

 +2        QUIT