IBDF6C.m

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 ---IBDF6C   1079     printed  Apr 09, 2024@21:39:01                                                                                                                                                                                                      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