38 lines
1.2 KiB
Mathematica
38 lines
1.2 KiB
Mathematica
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
|