source: WorldVistAEHR/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDF15.m@ 1608

Last change on this file since 1608 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.2 KB
Line 
1IBDF15 ;ALB/CJM - AICS FORM USE BY DIVISION/CLINIC ; JUL 20,1993
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
3 ;
4FORMUSE ; -- prints for each encounter form the clinics using it
5 ;
6% N FORM,FORMNAM,CLINIC,NODE,PAGE,IBQUIT,IBHDT,X,Y,CLNAME,DIVIS,DIVNAM,NEWDIV,VAUTD,MULTI
7 S IBQUIT=0
8 W !!,"AICS List of Clinics Using Encounter Forms",!!
9 D DIVIS G:IBQUIT EXIT
10 D DEVICE G:IBQUIT EXIT
11 D DQ G EXIT
12 Q
13 ;
14EXIT ; -- exit routine
15 K ^TMP($J,"IBDCS"),^TMP($J,"IBDCN"),^TMP($J,"IBDCL")
16 I $D(ZTQUEUED) S ZTREQ="@" Q
17 D ^%ZISC
18 Q
19 ;
20DQ ; -- entry point from task man
21 K ^TMP($J,"IBDCS"),^TMP($J,"IBDCN"),^TMP($J,"IBDCL")
22 S IBQUIT=0,PAGE=1
23 S IBHDT=$$HTE^XLFDT($H,1)
24 D PRINT^IBDF15A
25 Q
26 ;
27DEVICE ; -- select device
28 S %ZIS="MQ" D ^%ZIS I POP S IBQUIT=1 Q
29 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
30 U IO
31 Q
32 ;
33DIVIS ; -- SETUP DIVISION
34 N X,Y S VAUTD=1,MULTI=0
35 I $P($G(^DG(43,1,"GL")),"^",2) S MULTI=1 D DIVISION^VAUTOMA S:Y=-1 IBQUIT=1
36 I 'VAUTD S X="" F S X=$O(VAUTD(X)) Q:'X S ^TMP($J,"IBDCS",$P($G(^DG(40.8,+X,0)),"^"))=""
37 Q
Note: See TracBrowser for help on using the repository browser.