IBDF6C ;ALB/CJM - ENCOUNTER FORM - (deleting setup, editing form name) ;JAN 16,1993
;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
;
DSETUP ;allows user to select a form, then removes it from the clinic setup
N SEL,IBFORM,SETUP
D EN^VALM2($G(XQORNOD(0)),"S")
S SEL=$O(VALMY("")),(IBFORM,VALMBCK)=""
I SEL S SEL=$G(@VALMAR@("IDX",2*SEL,SEL)),IBFORM=+SEL
I IBFORM D
.S VALMBCK="R"
.K DA S DA=$O(^SD(409.95,"B",+$G(IBCLINIC),"")) Q:'DA
.S SETUP=$G(^SD(409.95,DA,0)) Q:SETUP=""
.S DR=$P(SEL,"^",2)_"////@"
.K DIE S DIE=409.95 D ^DIE K DIE,DR,DA
.X IBAPI("INDEX")
Q
EDITFORM ;allows user to select a form, then edit its name, description, and size
N IBFORM,IBDELETE,IBSCAN,IBOLD ;IBDELETE,IBSCAN,IBOLD appear in the input template
I $G(IBAPI("SELECT"))'="" X IBAPI("SELECT")
S VALMBCK="R"
I IBFORM D
.D UNCMPALL^IBDF19(IBFORM)
.D FULL^VALM1
.S VALMBCK="R"
.K DA,DR,DIE S DA=IBFORM
.S DR="[IBDF EDIT OLD OR COPIED FORM]"
.S IBOLD=$S($P($G(^IBE(357,IBFORM,0)),"^",16):0,1:1)
.S DIE=357 D ^DIE K DIE,DR,DA
.X IBAPI("INDEX")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDF6C 1079 printed Dec 13, 2024@02:51:36 Page 2
IBDF6C ;ALB/CJM - ENCOUNTER FORM - (deleting setup, editing form name) ;JAN 16,1993
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
+2 ;
DSETUP ;allows user to select a form, then removes it from the clinic setup
+1 NEW SEL,IBFORM,SETUP
+2 DO EN^VALM2($GET(XQORNOD(0)),"S")
+3 SET SEL=$ORDER(VALMY(""))
SET (IBFORM,VALMBCK)=""
+4 IF SEL
SET SEL=$GET(@VALMAR@("IDX",2*SEL,SEL))
SET IBFORM=+SEL
+5 IF IBFORM
Begin DoDot:1
+6 SET VALMBCK="R"
+7 KILL DA
SET DA=$ORDER(^SD(409.95,"B",+$GET(IBCLINIC),""))
if 'DA
QUIT
+8 SET SETUP=$GET(^SD(409.95,DA,0))
if SETUP=""
QUIT
+9 SET DR=$PIECE(SEL,"^",2)_"////@"
+10 KILL DIE
SET DIE=409.95
DO ^DIE
KILL DIE,DR,DA
+11 XECUTE IBAPI("INDEX")
End DoDot:1
+12 QUIT
EDITFORM ;allows user to select a form, then edit its name, description, and size
+1 ;IBDELETE,IBSCAN,IBOLD appear in the input template
NEW IBFORM,IBDELETE,IBSCAN,IBOLD
+2 IF $GET(IBAPI("SELECT"))'=""
XECUTE IBAPI("SELECT")
+3 SET VALMBCK="R"
+4 IF IBFORM
Begin DoDot:1
+5 DO UNCMPALL^IBDF19(IBFORM)
+6 DO FULL^VALM1
+7 SET VALMBCK="R"
+8 KILL DA,DR,DIE
SET DA=IBFORM
+9 SET DR="[IBDF EDIT OLD OR COPIED FORM]"
+10 SET IBOLD=$SELECT($PIECE($GET(^IBE(357,IBFORM,0)),"^",16):0,1:1)
+11 SET DIE=357
DO ^DIE
KILL DIE,DR,DA
+12 XECUTE IBAPI("INDEX")
End DoDot:1
+13 QUIT
