SROPOST1.m

SROPOST1 ;B'HAM ISC/ADM - MOVE SPECIALTIES INTO LOCAL FILE ;  23-APR-92  15:15

 ;;3.0; Surgery ;**5,6**;24 Jun 93

 Q:'$D(^SRO(137.45,0))!($O(^SRO(137.45,0)))  W !!,"Setting up Local Surgical Specialty file... "

 F I=50:1:62,500,501,502 S SRCODE(I)=I

 S SRSS=0 F  S SRSS=$O(^DIC(45.3,SRSS)) Q:'SRSS  S SRPTF=$P(^DIC(45.3,SRSS,0),"^") D FILE

 S SRLOCAL=0 F  S SRLOCAL=$O(^SRO(137.45,SRLOCAL)) Q:'SRLOCAL  D:SRL(SRLOCAL)'="" POINT D:SRL(SRLOCAL)="" SEL

 W !!,"Set-up of Local Specialty file completed."

END K DA,DIC,DINUM,DR,I,SRCODE,SRL,SRLOCAL,SRPTF,SRSS,X

 Q

FILE ;

 I '$D(SRCODE(SRPTF)) S SRPTF=""

 S X=$P(^DIC(45.3,SRSS,0),"^",2) K DIC S DIC="^SRO(137.45,",DIC(0)="L",DINUM=SRSS,DLAYGO=137.45 D FILE^DICN K DIC,DLAYGO Q:'+Y  S SRL(+Y)=SRPTF

 Q

POINT ;

 K DIC S X=SRL(SRLOCAL),DIC=45.3,DIC(0)="" D ^DIC K DIC I Y<0 S SRL(SRLOCAL)="" Q

 K DD,DO,DA,DR S DA=SRLOCAL,DR="1///"_SRL(SRLOCAL),DIE=137.45 D ^DIE K DIE

 Q

SEL W !!,"Point Local Surgical Specialty ",$P(^SRO(137.45,SRLOCAL,0),"^"),!," to what National Surgical Specialty ?",!

 W "(Note!! If no entry is made it will be pointed automatically",!,"to the National Surgical Specialty ",$P(^DIC(45.3,1,0),"^",2),".)"

 K DD,DO,DA,DINUM S DA=SRLOCAL,DIE=137.45,DR="1T//"_$E($P(^DIC(45.3,1,0),"^",2),1,30) D ^DIE K DIE

 I '$P(^SRO(137.45,SRLOCAL,0),"^",2) K DD,DO,DA,DINUM S DA=SRLOCAL,DIE=137.45,DR="1////1" D ^DIE K DIE

 Q

AMM ; Logic for SR*3*6 if Surgery v3 is already installed

 D WAIT^DICD K ^SRF("AMM") S SRTN=0

 F  S SRTN=$O(^SRF(SRTN)) Q:SRTN'>0  I $D(^SRF(SRTN,0)),$P($G(^S,5) D SET11

 W !!,"Process is finished." K DA,DIK,SRSTART,SRTN

 Q

SET11 ; Convert SCHEDULE START TIME to numeric form and re-index AMM

 S SRSTART=$P(^SRF(SRTN,31),"^",4) Q:SRSTART=""  I SRSTART'=+SRSRTN,31),"^",4)=+SRSTART

 Q:$P(^SRF(SRTN,0),"^",2)=""

 K DA,DIK S DIK="^SRF(",DIK(1)="11^AMM",DA=SRTN D EN1^DIK

 Q

SROPOST1  ;B'HAM ISC/ADM - MOVE SPECIALTIES INTO LOCAL FILE ;  23-APR-92  15:15

 +1       ;;3.0; Surgery ;**5,6**;24 Jun 93

 +2        IF '$DATA(^SRO(137.45,0))!($ORDER(^SRO(137.45,0)))

               QUIT 

           WRITE !!,"Setting up Local Surgical Specialty file... "

 +3        FOR I=50:1:62,500,501,502

               SET SRCODE(I)=I

 +4        SET SRSS=0

           FOR 

               SET SRSS=$ORDER(^DIC(45.3,SRSS))

               IF 'SRSS

                   QUIT 

               SET SRPTF=$PIECE(^DIC(45.3,SRSS,0),"^")

               DO FILE

 +5        SET SRLOCAL=0

           FOR 

               SET SRLOCAL=$ORDER(^SRO(137.45,SRLOCAL))

               IF 'SRLOCAL

                   QUIT 

               IF SRL(SRLOCAL)'=""

                   DO POINT

               IF SRL(SRLOCAL)=""

                   DO SEL

 +6        WRITE !!,"Set-up of Local Specialty file completed."

END        KILL DA,DIC,DINUM,DR,I,SRCODE,SRL,SRLOCAL,SRPTF,SRSS,X

 +1        QUIT 

FILE      ;

 +1        IF '$DATA(SRCODE(SRPTF))

               SET SRPTF=""

 +2        SET X=$PIECE(^DIC(45.3,SRSS,0),"^",2)

           KILL DIC

           SET DIC="^SRO(137.45,"

           SET DIC(0)="L"

           SET DINUM=SRSS

           SET DLAYGO=137.45

           DO FILE^DICN

           KILL DIC,DLAYGO

           IF '+Y

               QUIT 

           SET SRL(+Y)=SRPTF

 +3        QUIT 

POINT     ;

 +1        KILL DIC

           SET X=SRL(SRLOCAL)

           SET DIC=45.3

           SET DIC(0)=""

           DO ^DIC

           KILL DIC

           IF Y<0

               SET SRL(SRLOCAL)=""

               QUIT 

 +2        KILL DD,DO,DA,DR

           SET DA=SRLOCAL

           SET DR="1///"_SRL(SRLOCAL)

           SET DIE=137.45

           DO ^DIE

           KILL DIE

 +3        QUIT 

SEL        WRITE !!,"Point Local Surgical Specialty ",$PIECE(^SRO(137.45,SRLOCAL,0),"^"),!," to what National Surgical Specialty ?",!

 +1        WRITE "(Note!! If no entry is made it will be pointed automatically",!,"to the National Surgical Specialty ",$PIECE(^DIC(45.3,1,0),"^",2),".)"

 +2        KILL DD,DO,DA,DINUM

           SET DA=SRLOCAL

           SET DIE=137.45

           SET DR="1T//"_$EXTRACT($PIECE(^DIC(45.3,1,0),"^",2),1,30)

           DO ^DIE

           KILL DIE

 +3        IF '$PIECE(^SRO(137.45,SRLOCAL,0),"^",2)

               KILL DD,DO,DA,DINUM

               SET DA=SRLOCAL

               SET DIE=137.45

               SET DR="1////1"

               DO ^DIE

               KILL DIE

 +4        QUIT 

AMM       ; Logic for SR*3*6 if Surgery v3 is already installed

 +1        DO WAIT^DICD

           KILL ^SRF("AMM")

           SET SRTN=0

 +2        FOR 

               SET SRTN=$ORDER(^SRF(SRTN))

               IF SRTN'>0

                   QUIT 

               IF $DATA(^SRF(SRTN,0))

                   IF $PIECE($GET(^S,5)

                       DO SET11

 +3        WRITE !!,"Process is finished."

           KILL DA,DIK,SRSTART,SRTN

 +4        QUIT 

SET11     ; Convert SCHEDULE START TIME to numeric form and re-index AMM

 +1        SET SRSTART=$PIECE(^SRF(SRTN,31),"^",4)

           IF SRSTART=""

               QUIT 

           IF SRSTART'=+SRSRTN

               IF 31)

                   IF "^"

                       IF 4)=+SRSTART

 +2        IF $PIECE(^SRF(SRTN,0),"^",2)=""

               QUIT 

 +3        KILL DA,DIK

           SET DIK="^SRF("

           SET DIK(1)="11^AMM"

           SET DA=SRTN

           DO EN1^DIK

 +4        QUIT