IBDF12.m

IBDF12 ;ALB/CJM - ENCOUNTER FORM - ENTRY FOR EDITING TOOLKIT FORMS ;JUN 16,1992

 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997

 ;

 ;*** NOTE:

 ;IBTKFORM=1 while editing a tk form

 ;IBTKBLK=0 while editing blocks on a tk form - because they are not tk blocks 

FORMLIST ;

 N IBTKFORM,IBTKBLK,IBDEVICE,IBAPI

 S IBTKFORM=1,IBTKBLK=0

 N IBFASTXT ;set to 1 for fast exit from system

 S IBFASTXT=0

 S IBAPI("INDEX")="D IDXFORMS^IBDF12"

 S IBAPI("SELECT")="D SELECT^IBDF12"

 D DEVICE^IBDFUA(1,.IBDEVICE)

 K XQORS,VALMEVL

 S IBCLINIC=""

 D EN^VALM("IBDF TOOL KIT FORMS")

 Q

ONENTRY ;

 D IDXFORMS

 Q

ONEXIT ;

 D KILL^%ZISS

 K ^TMP("IB",$J),^TMP("IBDF",$J),IBCLINIC,VALMY,IBQUIT,VALMBCK,X,Y,I,DA,D0

 Q

 ;

IDXFORMS ;build an array of toolkit forms

 N FORM,NODE

 K @VALMAR

 S VALMCNT=0

 S FORM=0 F  S FORM=$O(^IBE(357,"C",1,FORM)) Q:'FORM  S NODE=$G(^IBE(357,FORM,0)) I +$P(NODE,"^",7),$P(NODE,"^")'="TOOL KIT",$P(NODE,"^")'="WORKCOPY" D ENTRY

 Q

ENTRY ;adds an entry to the array

 S VALMCNT=VALMCNT+1,@VALMAR@(VALMCNT,0)=$J(VALMCNT,3)_"  "_$$PADRIGHT^IBDFU($P(NODE,"^",1),30)_"  "_$E($P(NODE,"^",3),1,80)

 S @VALMAR@("IDX",VALMCNT,VALMCNT)=FORM D FLDCTRL^VALM10(VALMCNT) ;set video for ID column

 S @VALMAR@("IDX",VALMCNT,VALMCNT)=FORM_"^"

 Q

HDR ;

 S VALMHDR(1)="TOOLKIT FORMS"

 Q

DELFORM ;allows user to select a form, then deletes it

 N SEL,FORM

 D EN^VALM2($G(XQORNOD(0)),"S")

 S SEL=$O(VALMY("")),FORM=""

 I SEL S FORM=+$G(@VALMAR@("IDX",SEL,SEL))

 I FORM D DELETE^IBDFU2C(FORM,357,1)

 S VALMBCK="R"

 D IDXFORMS

 Q

 ;

SELECT ;

 N SEL

 S IBFORM=""

 D EN^VALM2($G(XQORNOD(0)),"S")

 S SEL=$O(VALMY(""))

 I SEL S IBFORM=+$G(@VALMAR@("IDX",SEL,SEL))

 Q

IBDF12    ;ALB/CJM - ENCOUNTER FORM - ENTRY FOR EDITING TOOLKIT FORMS ;JUN 16,1992

 +1       ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997

 +2       ;

 +3       ;*** NOTE:

 +4       ;IBTKFORM=1 while editing a tk form

 +5       ;IBTKBLK=0 while editing blocks on a tk form - because they are not tk blocks 

FORMLIST  ;

 +1        NEW IBTKFORM,IBTKBLK,IBDEVICE,IBAPI

 +2        SET IBTKFORM=1

           SET IBTKBLK=0

 +3       ;set to 1 for fast exit from system

           NEW IBFASTXT

 +4        SET IBFASTXT=0

 +5        SET IBAPI("INDEX")="D IDXFORMS^IBDF12"

 +6        SET IBAPI("SELECT")="D SELECT^IBDF12"

 +7        DO DEVICE^IBDFUA(1,.IBDEVICE)

 +8        KILL XQORS,VALMEVL

 +9        SET IBCLINIC=""

 +10       DO EN^VALM("IBDF TOOL KIT FORMS")

 +11       QUIT 

ONENTRY   ;

 +1        DO IDXFORMS

 +2        QUIT 

ONEXIT    ;

 +1        DO KILL^%ZISS

 +2        KILL ^TMP("IB",$JOB),^TMP("IBDF",$JOB),IBCLINIC,VALMY,IBQUIT,VALMBCK,X,Y,I,DA,D0

 +3        QUIT 

 +4       ;

IDXFORMS  ;build an array of toolkit forms

 +1        NEW FORM,NODE

 +2        KILL @VALMAR

 +3        SET VALMCNT=0

 +4        SET FORM=0

           FOR 

               SET FORM=$ORDER(^IBE(357,"C",1,FORM))

               IF 'FORM

                   QUIT 

               SET NODE=$GET(^IBE(357,FORM,0))

               IF +$PIECE(NODE,"^",7)

                   IF $PIECE(NODE,"^")'="TOOL KIT"

                       IF $PIECE(NODE,"^")'="WORKCOPY"

                           DO ENTRY

 +5        QUIT 

ENTRY     ;adds an entry to the array

 +1        SET VALMCNT=VALMCNT+1

           SET @VALMAR@(VALMCNT,0)=$JUSTIFY(VALMCNT,3)_"  "_$$PADRIGHT^IBDFU($PIECE(NODE,"^",1),30)_"  "_$EXTRACT($PIECE(NODE,"^",3),1,80)

 +2       ;set video for ID column

           SET @VALMAR@("IDX",VALMCNT,VALMCNT)=FORM

           DO FLDCTRL^VALM10(VALMCNT)

 +3        SET @VALMAR@("IDX",VALMCNT,VALMCNT)=FORM_"^"

 +4        QUIT 

HDR       ;

 +1        SET VALMHDR(1)="TOOLKIT FORMS"

 +2        QUIT 

DELFORM   ;allows user to select a form, then deletes it

 +1        NEW SEL,FORM

 +2        DO EN^VALM2($GET(XQORNOD(0)),"S")

 +3        SET SEL=$ORDER(VALMY(""))

           SET FORM=""

 +4        IF SEL

               SET FORM=+$GET(@VALMAR@("IDX",SEL,SEL))

 +5        IF FORM

               DO DELETE^IBDFU2C(FORM,357,1)

 +6        SET VALMBCK="R"

 +7        DO IDXFORMS

 +8        QUIT 

 +9       ;

SELECT    ;

 +1        NEW SEL

 +2        SET IBFORM=""

 +3        DO EN^VALM2($GET(XQORNOD(0)),"S")

 +4        SET SEL=$ORDER(VALMY(""))

 +5        IF SEL

               SET IBFORM=+$GET(@VALMAR@("IDX",SEL,SEL))

 +6        QUIT