IBDF14 ;ALB/CJM - AICS LIST CLINIC SETUP ; JUL 20,1993
;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
;
SETUPS ; -- Lists forms/reports defined in print manager clinic setup
;
% N CLINIC,SETUP,NODE,COND,INTRFACE,PAGE,IBQUIT,IBHDT,X,Y,FORM,REPORT,NAME,VAUTD,DIVIS,NEWDIV,CNT,MULTI
W !!,"AICS Print Manager Clinic Setup Report",!!
S IBQUIT=0
D DIVIS G:IBQUIT EXIT
D DEVICE G:IBQUIT EXIT
D DQ
G EXIT
Q
;
EXIT ; -- exit module
K ^TMP($J,"IBCS")
I $D(ZTQUEUED) S ZTREQ="@" Q
D ^%ZISC
K ZTSK,ZTDESC,ZTSAVE,ZTRTN
Q
;
DQ ; -- entry point from task man
K ^TMP($J,"IBCS")
S IBQUIT=0,PAGE=1
S IBHDT=$$HTE^XLFDT($H,1)
D ^IBDF14A
Q
;
DEVICE ; -- ask device
S %ZIS="MQ" D ^%ZIS I POP S IBQUIT=1 Q
I $D(IO("Q")) S ZTRTN="DQ^IBDF14",ZTDESC="IBD - Print Manager Clinic Setup",ZTSAVE("VA*")="",ZTSAVE("MULTI")="" D ^%ZTLOAD W !,$S($D(ZTSK):"Request Queued Task="_ZTSK,1:"Request Canceled") D HOME^%ZIS S IBQUIT=1 Q
U IO
Q
;
DIVIS ; -- Select 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,"IBCS",$P($G(^DG(40.8,+X,0)),"^"))=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDF14 1199 printed Dec 13, 2024@02:50:43 Page 2
IBDF14 ;ALB/CJM - AICS LIST CLINIC SETUP ; JUL 20,1993
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
+2 ;
SETUPS ; -- Lists forms/reports defined in print manager clinic setup
+1 ;
% NEW CLINIC,SETUP,NODE,COND,INTRFACE,PAGE,IBQUIT,IBHDT,X,Y,FORM,REPORT,NAME,VAUTD,DIVIS,NEWDIV,CNT,MULTI
+1 WRITE !!,"AICS Print Manager Clinic Setup Report",!!
+2 SET IBQUIT=0
+3 DO DIVIS
if IBQUIT
GOTO EXIT
+4 DO DEVICE
if IBQUIT
GOTO EXIT
+5 DO DQ
+6 GOTO EXIT
+7 QUIT
+8 ;
EXIT ; -- exit module
+1 KILL ^TMP($JOB,"IBCS")
+2 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+3 DO ^%ZISC
+4 KILL ZTSK,ZTDESC,ZTSAVE,ZTRTN
+5 QUIT
+6 ;
DQ ; -- entry point from task man
+1 KILL ^TMP($JOB,"IBCS")
+2 SET IBQUIT=0
SET PAGE=1
+3 SET IBHDT=$$HTE^XLFDT($HOROLOG,1)
+4 DO ^IBDF14A
+5 QUIT
+6 ;
DEVICE ; -- ask device
+1 SET %ZIS="MQ"
DO ^%ZIS
IF POP
SET IBQUIT=1
QUIT
+2 IF $DATA(IO("Q"))
SET ZTRTN="DQ^IBDF14"
SET ZTDESC="IBD - Print Manager Clinic Setup"
SET ZTSAVE("VA*")=""
SET ZTSAVE("MULTI")=""
DO ^%ZTLOAD
WRITE !,$SELECT($DATA(ZTSK):"Request Queued Task="_ZTSK,1:"Request Canceled")
DO HOME^%ZIS
SET IBQUIT=1
QUIT
+3 USE IO
+4 QUIT
+5 ;
DIVIS ; -- Select 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,"IBCS",$PIECE($GET(^DG(40.8,+X,0)),"^"))=""
+4 QUIT
