IBDF14.m

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 ---IBDF14   1199     printed  Mar 13, 2025@21:55:46                                                                                                                                                                                                      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