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 ---[H[J[2J[HECTP13 1629 printed Nov 22, 2024@17:12:35 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
