- 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 Feb 19, 2025@00:18:29 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
