IBDF15.m

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 ---IBDF15   1252     printed  Apr 09, 2024@21:14:39                                                                                                                                                                                                      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