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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDF15 1252 printed Oct 16, 2024@18:51:31 Page 2
IBDF15 ;ALB/CJM - AICS FORM USE BY DIVISION/CLINIC ; JUL 20,1993
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
+2 ;
FORMUSE ; -- prints for each encounter form the clinics using it
+1 ;
% NEW FORM,FORMNAM,CLINIC,NODE,PAGE,IBQUIT,IBHDT,X,Y,CLNAME,DIVIS,DIVNAM,NEWDIV,VAUTD,MULTI
+1 SET IBQUIT=0
+2 WRITE !!,"AICS List of Clinics Using Encounter Forms",!!
+3 DO DIVIS
if IBQUIT
GOTO EXIT
+4 DO DEVICE
if IBQUIT
GOTO EXIT
+5 DO DQ
GOTO EXIT
+6 QUIT
+7 ;
EXIT ; -- exit routine
+1 KILL ^TMP($JOB,"IBDCS"),^TMP($JOB,"IBDCN"),^TMP($JOB,"IBDCL")
+2 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+3 DO ^%ZISC
+4 QUIT
+5 ;
DQ ; -- entry point from task man
+1 KILL ^TMP($JOB,"IBDCS"),^TMP($JOB,"IBDCN"),^TMP($JOB,"IBDCL")
+2 SET IBQUIT=0
SET PAGE=1
+3 SET IBHDT=$$HTE^XLFDT($HOROLOG,1)
+4 DO PRINT^IBDF15A
+5 QUIT
+6 ;
DEVICE ; -- select device
+1 SET %ZIS="MQ"
DO ^%ZIS
IF POP
SET IBQUIT=1
QUIT
+2 IF $DATA(IO("Q"))
SET ZTRTN="DQ^IBDF15"
SET ZTDESC="REPORT OF ENCOUNTER FORMS USED BY CLINICS"
SET ZTSAVE("VA*")=""
SET ZTSAVE("MULTI")=""
DO ^%ZTLOAD
WRITE !,$SELECT($DATA(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
DO HOME^%ZIS
SET IBQUIT=1
QUIT
+3 USE IO
+4 QUIT
+5 ;
DIVIS ; -- SETUP DIVISION
+1 NEW X,Y
SET VAUTD=1
SET MULTI=0
+2 IF $PIECE($GET(^DG(43,1,"GL")),"^",2)
SET MULTI=1
DO DIVISION^VAUTOMA
if Y=-1
SET IBQUIT=1
+3 IF 'VAUTD
SET X=""
FOR
SET X=$ORDER(VAUTD(X))
if 'X
QUIT
SET ^TMP($JOB,"IBDCS",$PIECE($GET(^DG(40.8,+X,0)),"^"))=""
+4 QUIT
