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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDFC3 1680 printed Nov 22, 2024@18:02:14 Page 2
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
