| 1 | IBDFC3 ;ALB/CJM - ENCOUNTER FORM - replace original form with converted form ;MAR 3, 1995
|
|---|
| 2 | ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | REPLACE ;replaces the original form with the converted form
|
|---|
| 5 | N IBFORM,OLDFORM,IBCNVRT,NODE,OLDNAME,NEWNAME
|
|---|
| 6 | S VALMBCK="R"
|
|---|
| 7 | ;D FULL^VALM1
|
|---|
| 8 | W !,"The original form will be replaced with the converted form in all of the",!,"clinics and divisions where it is used."
|
|---|
| 9 | K DIR S DIR(0)="Y",DIR("B")="YES",DIR("A")="Is that okay"
|
|---|
| 10 | D ^DIR K DIR
|
|---|
| 11 | I (Y=1)&'$D(DIRUT) D
|
|---|
| 12 | .X IBAPI("SELECT")
|
|---|
| 13 | .Q:'IBFORM
|
|---|
| 14 | .Q:'IBCNVRT
|
|---|
| 15 | .S NODE=$G(^IBD(359,IBCNVRT,0))
|
|---|
| 16 | .S OLDFORM=$P(NODE,"^",2),OLDNAME=$P(NODE,"^",3)
|
|---|
| 17 | .Q:'OLDFORM
|
|---|
| 18 | .D LOOP
|
|---|
| 19 | .S $P(^IBD(359,IBCNVRT,0),"^",5)=1
|
|---|
| 20 | .;
|
|---|
| 21 | .;delete the original?
|
|---|
| 22 | .W !,"The converted form has been substituted everywhere for the original"
|
|---|
| 23 | .S DIR(0)="Y",DIR("B")="YES",DIR("A")="Do you want the original form deleted"
|
|---|
| 24 | .D ^DIR K DIR
|
|---|
| 25 | .I (Y=1)&'$D(DIRUT) D
|
|---|
| 26 | ..D DELETE^IBDFU2C(OLDFORM,357)
|
|---|
| 27 | ..;rename the converted form to take out the CNV. prefix
|
|---|
| 28 | ..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
|
|---|
| 29 | ...K DIE,DA,DR S DIE="^IBE(357,",DA=IBFORM,DR=".01////"_NAME D ^DIE K DIE,DA,DR
|
|---|
| 30 | .;
|
|---|
| 31 | .D IDXFORMS^IBDFC1
|
|---|
| 32 | K Y
|
|---|
| 33 | Q
|
|---|
| 34 | ;
|
|---|
| 35 | LOOP ;loops through the clinic setups and divisions setups, making the substitutions
|
|---|
| 36 | N SETUP,NODE,PIECE,FOUND
|
|---|
| 37 | S SETUP=0 F S SETUP=$O(^SD(409.95,SETUP)) Q:'SETUP D
|
|---|
| 38 | .S NODE=$G(^SD(409.95,SETUP,0))
|
|---|
| 39 | .K DR S DR=""
|
|---|
| 40 | .S FOUND=0
|
|---|
| 41 | .F PIECE=2:1:12 I $P(NODE,"^",PIECE)=OLDFORM S DR=DR_(.01*PIECE)_"////"_IBFORM_";",FOUND=1
|
|---|
| 42 | .I FOUND K DIE,DA S DIE="^SD(409.95,",DA=SETUP D ^DIE
|
|---|
| 43 | .K DIE,DR,DA
|
|---|
| 44 | Q
|
|---|
