IBDFC3.m

IBDFC3 ;ALB/CJM - ENCOUNTER FORM - replace original form with converted form ;MAR 3, 1995

 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997

 ;

REPLACE ;replaces the original form with the converted form

 N IBFORM,OLDFORM,IBCNVRT,NODE,OLDNAME,NEWNAME

 S VALMBCK="R"

 ;D FULL^VALM1

 W !,"The original form will be replaced with the converted form in all of the",!,"clinics and divisions where it is used."

 K DIR S DIR(0)="Y",DIR("B")="YES",DIR("A")="Is that okay"

 D ^DIR K DIR

 I (Y=1)&'$D(DIRUT) D

 .X IBAPI("SELECT")

 .Q:'IBFORM

 .Q:'IBCNVRT

 .S NODE=$G(^IBD(359,IBCNVRT,0))

 .S OLDFORM=$P(NODE,"^",2),OLDNAME=$P(NODE,"^",3)

 .Q:'OLDFORM

 .D LOOP

 .S $P(^IBD(359,IBCNVRT,0),"^",5)=1

 .;

 .;delete the original?

 .W !,"The converted form has been substituted everywhere for the original"

 .S DIR(0)="Y",DIR("B")="YES",DIR("A")="Do you want the original form deleted"

 .D ^DIR K DIR

 .I (Y=1)&'$D(DIRUT) D

 ..D DELETE^IBDFU2C(OLDFORM,357)

 ..;rename the converted form to take out the CNV. prefix

 ..S NAME=$P($G(^IBE(357,IBFORM,0)),"^") I $E(NAME,1,4)="CNV." S NAME=$E(NAME,5,45) S:(NAME=$E(OLDNAME,1,$L(NAME))) NAME=OLDNAME D

 ...K DIE,DA,DR S DIE="^IBE(357,",DA=IBFORM,DR=".01////"_NAME D ^DIE K DIE,DA,DR

 .;

 .D IDXFORMS^IBDFC1

 K Y

 Q

 ;

LOOP ;loops through the clinic setups and divisions setups, making the substitutions

 N SETUP,NODE,PIECE,FOUND

 S SETUP=0 F  S SETUP=$O(^SD(409.95,SETUP)) Q:'SETUP  D

 .S NODE=$G(^SD(409.95,SETUP,0))

 .K DR S DR=""

 .S FOUND=0

 .F PIECE=2:1:12 I $P(NODE,"^",PIECE)=OLDFORM S DR=DR_(.01*PIECE)_"////"_IBFORM_";",FOUND=1

 .I FOUND K DIE,DA S DIE="^SD(409.95,",DA=SETUP D ^DIE

 .K DIE,DR,DA

 Q

IBDFC3    ;ALB/CJM - ENCOUNTER FORM - replace original form with converted form ;MAR 3, 1995

 +1       ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997

 +2       ;

REPLACE   ;replaces the original form with the converted form

 +1        NEW IBFORM,OLDFORM,IBCNVRT,NODE,OLDNAME,NEWNAME

 +2        SET VALMBCK="R"

 +3       ;D FULL^VALM1

 +4        WRITE !,"The original form will be replaced with the converted form in all of the",!,"clinics and divisions where it is used."

 +5        KILL DIR

           SET DIR(0)="Y"

           SET DIR("B")="YES"

           SET DIR("A")="Is that okay"

 +6        DO ^DIR

           KILL DIR

 +7        IF (Y=1)&'$DATA(DIRUT)

               Begin DoDot:1

 +8                XECUTE IBAPI("SELECT")

 +9                IF 'IBFORM

                       QUIT 

 +10               IF 'IBCNVRT

                       QUIT 

 +11               SET NODE=$GET(^IBD(359,IBCNVRT,0))

 +12               SET OLDFORM=$PIECE(NODE,"^",2)

                   SET OLDNAME=$PIECE(NODE,"^",3)

 +13               IF 'OLDFORM

                       QUIT 

 +14               DO LOOP

 +15               SET $PIECE(^IBD(359,IBCNVRT,0),"^",5)=1

 +16      ;

 +17      ;delete the original?

 +18               WRITE !,"The converted form has been substituted everywhere for the original"

 +19               SET DIR(0)="Y"

                   SET DIR("B")="YES"

                   SET DIR("A")="Do you want the original form deleted"

 +20               DO ^DIR

                   KILL DIR

 +21               IF (Y=1)&'$DATA(DIRUT)

                       Begin DoDot:2

 +22                       DO DELETE^IBDFU2C(OLDFORM,357)

 +23      ;rename the converted form to take out the CNV. prefix

 +24                       SET NAME=$PIECE($GET(^IBE(357,IBFORM,0)),"^")

                           IF $EXTRACT(NAME,1,4)="CNV."

                               SET NAME=$EXTRACT(NAME,5,45)

                               IF (NAME=$EXTRACT(OLDNAME,1,$LENGTH(NAME)))

                                   SET NAME=OLDNAME

                               Begin DoDot:3

 +25                               KILL DIE,DA,DR

                                   SET DIE="^IBE(357,"

                                   SET DA=IBFORM

                                   SET DR=".01////"_NAME

                                   DO ^DIE

                                   KILL DIE,DA,DR

                               End DoDot:3

                       End DoDot:2

 +26      ;

 +27               DO IDXFORMS^IBDFC1

               End DoDot:1

 +28       KILL Y

 +29       QUIT 

 +30      ;

LOOP      ;loops through the clinic setups and divisions setups, making the substitutions

 +1        NEW SETUP,NODE,PIECE,FOUND

 +2        SET SETUP=0

           FOR 

               SET SETUP=$ORDER(^SD(409.95,SETUP))

               IF 'SETUP

                   QUIT 

               Begin DoDot:1

 +3                SET NODE=$GET(^SD(409.95,SETUP,0))

 +4                KILL DR

                   SET DR=""

 +5                SET FOUND=0

 +6                FOR PIECE=2:1:12

                       IF $PIECE(NODE,"^",PIECE)=OLDFORM

                           SET DR=DR_(.01*PIECE)_"////"_IBFORM_";"

                           SET FOUND=1

 +7                IF FOUND

                       KILL DIE,DA

                       SET DIE="^SD(409.95,"

                       SET DA=SETUP

                       DO ^DIE

 +8                KILL DIE,DR,DA

               End DoDot:1

 +9        QUIT