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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDF12 1702 printed Dec 13, 2024@02:50:41 Page 2
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
