- 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
- 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