ECTP13.m

ECTP13 ;B'ham ISC/PTD - Patch Routine to Update the National Service File ;11/02/93 08:00

V ;;1.05;INTERIM MANAGEMENT SUPPORT;**13**;

 I '$O(^ECC(730,0)) W !,"National Service File - #730 does not exist on your system.",!,"This routine is unable to update the file!" G EXIT

 W !!,"This routine will update your National Service File - #730.",!,"The following changes will be made:"

 W !!,"BUILDING MANAGEMENT will be changed to ENVIRONMENTAL MANAGEMENT.",!,"LABORATORY will be changed to PATHOLOGY & LABORATORY MEDICINE."

 W !,"PERSONNEL will be changed to HUMAN RESOURCES MANAGEMENT.",!,"REHABILITATION MEDICINE will be changed to PHYSICAL MEDICINE & REHABILITATION."

 S DIR(0)="Y",DIR("A")="Do you wish to continue?",DIR("B")="NO" D ^DIR I Y'=1 W !!,"No change has been made to File 730!",! G EXIT

 L +^ECC(730) W ! F JJ=1:1 S ECTSRV=$P($T(TEXT+JJ),";;",2) Q:ECTSRV=""  D LOOP

 L -^ECC(730) K ^ECC(730,"B") S DIK="^ECC(730,",DIK(1)=".01^B" D ENALL^DIK

EXIT K DA,DIC,DIK,DIR,DTOUT,DUOUT,DIRUT,DIROUT,ECTDA,ECTNEW,ECTOLD,ECTSRV,JJ,X,Y

 Q

 ;

LOOP ;Make change to individual file entry.

 S ECTDA=$P(ECTSRV,"^"),ECTOLD=$P(ECTSRV,"^",2),ECTNEW=$P(ECTSRV,"^",3)

 I $D(^ECC(730,ECTDA,0)),$P(^(0),"^")=ECTNEW Q  ;Entry previously converted.

 S $P(^ECC(730,ECTDA,0),"^")=ECTNEW W !,ECTOLD," has been changed to ",ECTNEW,"."

 Q

 ;

TEXT ;Services to be updated: Internal DA#^Old Service Name^New Service Name

 ;;6^BUILDING MANAGEMENT^ENVIRONMENTAL MANAGEMENT

 ;;20^LABORATORY^PATHOLOGY & LABORATORY MEDICINE

 ;;29^PERSONNEL^HUMAN RESOURCES MANAGEMENT

 ;;39^REHABILITATION MEDICINE^PHYSICAL MEDICINE & REHABILITATION

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ECTP13   1629     printed  Apr 09, 2024@21:05:14                                                                                                                                                                                                      Page 2

ECTP13    ;B'ham ISC/PTD - Patch Routine to Update the National Service File ;11/02/93 08:00

V         ;;1.05;INTERIM MANAGEMENT SUPPORT;**13**;

 +1        IF '$ORDER(^ECC(730,0))

               WRITE !,"National Service File - #730 does not exist on your system.",!,"This routine is unable to update the file!"

               GOTO EXIT

 +2        WRITE !!,"This routine will update your National Service File - #730.",!,"The following changes will be made:"

 +3        WRITE !!,"BUILDING MANAGEMENT will be changed to ENVIRONMENTAL MANAGEMENT.",!,"LABORATORY will be changed to PATHOLOGY & LABORATORY MEDICINE."

 +4        WRITE !,"PERSONNEL will be changed to HUMAN RESOURCES MANAGEMENT.",!,"REHABILITATION MEDICINE will be changed to PHYSICAL MEDICINE & REHABILITATION."

 +5        SET DIR(0)="Y"

           SET DIR("A")="Do you wish to continue?"

           SET DIR("B")="NO"

           DO ^DIR

           IF Y'=1

               WRITE !!,"No change has been made to File 730!",!

               GOTO EXIT

 +6        LOCK +^ECC(730)

           WRITE !

           FOR JJ=1:1

               SET ECTSRV=$PIECE($TEXT(TEXT+JJ),";;",2)

               if ECTSRV=""

                   QUIT 

               DO LOOP

 +7        LOCK -^ECC(730)

           KILL ^ECC(730,"B")

           SET DIK="^ECC(730,"

           SET DIK(1)=".01^B"

           DO ENALL^DIK

EXIT       KILL DA,DIC,DIK,DIR,DTOUT,DUOUT,DIRUT,DIROUT,ECTDA,ECTNEW,ECTOLD,ECTSRV,JJ,X,Y

 +1        QUIT 

 +2       ;

LOOP      ;Make change to individual file entry.

 +1        SET ECTDA=$PIECE(ECTSRV,"^")

           SET ECTOLD=$PIECE(ECTSRV,"^",2)

           SET ECTNEW=$PIECE(ECTSRV,"^",3)

 +2       ;Entry previously converted.

           IF $DATA(^ECC(730,ECTDA,0))

               IF $PIECE(^(0),"^")=ECTNEW

                   QUIT 

 +3        SET $PIECE(^ECC(730,ECTDA,0),"^")=ECTNEW

           WRITE !,ECTOLD," has been changed to ",ECTNEW,"."

 +4        QUIT 

 +5       ;

TEXT      ;Services to be updated: Internal DA#^Old Service Name^New Service Name

 +1       ;;6^BUILDING MANAGEMENT^ENVIRONMENTAL MANAGEMENT

 +2       ;;20^LABORATORY^PATHOLOGY & LABORATORY MEDICINE

 +3       ;;29^PERSONNEL^HUMAN RESOURCES MANAGEMENT

 +4       ;;39^REHABILITATION MEDICINE^PHYSICAL MEDICINE & REHABILITATION