IBDF15 ;ALB/CJM - AICS FORM USE BY DIVISION/CLINIC ; JUL 20,1993
 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
 ;
FORMUSE ; -- prints for each encounter form the clinics using it
 ;
% N FORM,FORMNAM,CLINIC,NODE,PAGE,IBQUIT,IBHDT,X,Y,CLNAME,DIVIS,DIVNAM,NEWDIV,VAUTD,MULTI
 S IBQUIT=0
 W !!,"AICS List of Clinics Using Encounter Forms",!!
 D DIVIS G:IBQUIT EXIT
 D DEVICE G:IBQUIT EXIT
 D DQ G EXIT
 Q
 ;
EXIT ; -- exit routine
 K ^TMP($J,"IBDCS"),^TMP($J,"IBDCN"),^TMP($J,"IBDCL")
 I $D(ZTQUEUED) S ZTREQ="@" Q
 D ^%ZISC
 Q
 ;
DQ ; -- entry point from task man
 K ^TMP($J,"IBDCS"),^TMP($J,"IBDCN"),^TMP($J,"IBDCL")
 S IBQUIT=0,PAGE=1
 S IBHDT=$$HTE^XLFDT($H,1)
 D PRINT^IBDF15A
 Q
 ;
DEVICE ; -- select device
 S %ZIS="MQ" D ^%ZIS I POP S IBQUIT=1 Q
 I $D(IO("Q")) S ZTRTN="DQ^IBDF15",ZTDESC="REPORT OF ENCOUNTER FORMS USED BY CLINICS",ZTSAVE("VA*")="",ZTSAVE("MULTI")="" D ^%ZTLOAD W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED") D HOME^%ZIS S IBQUIT=1 Q
 U IO
 Q
 ;
DIVIS ; -- SETUP DIVISION
 N X,Y S VAUTD=1,MULTI=0
 I $P($G(^DG(43,1,"GL")),"^",2) S MULTI=1 D DIVISION^VAUTOMA S:Y=-1 IBQUIT=1
 I 'VAUTD S X="" F  S X=$O(VAUTD(X)) Q:'X  S ^TMP($J,"IBDCS",$P($G(^DG(40.8,+X,0)),"^"))=""
 Q