source: WorldVistAEHR/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDF14.m@ 1150

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

initial load of WorldVistAEHR

File size: 1.1 KB
RevLine 
[613]1IBDF14 ;ALB/CJM - AICS LIST CLINIC SETUP ; JUL 20,1993
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
3 ;
4SETUPS ; -- Lists forms/reports defined in print manager clinic setup
5 ;
6% N CLINIC,SETUP,NODE,COND,INTRFACE,PAGE,IBQUIT,IBHDT,X,Y,FORM,REPORT,NAME,VAUTD,DIVIS,NEWDIV,CNT,MULTI
7 W !!,"AICS Print Manager Clinic Setup Report",!!
8 S IBQUIT=0
9 D DIVIS G:IBQUIT EXIT
10 D DEVICE G:IBQUIT EXIT
11 D DQ
12 G EXIT
13 Q
14 ;
15EXIT ; -- exit module
16 K ^TMP($J,"IBCS")
17 I $D(ZTQUEUED) S ZTREQ="@" Q
18 D ^%ZISC
19 K ZTSK,ZTDESC,ZTSAVE,ZTRTN
20 Q
21 ;
22DQ ; -- entry point from task man
23 K ^TMP($J,"IBCS")
24 S IBQUIT=0,PAGE=1
25 S IBHDT=$$HTE^XLFDT($H,1)
26 D ^IBDF14A
27 Q
28 ;
29DEVICE ; -- ask device
30 S %ZIS="MQ" D ^%ZIS I POP S IBQUIT=1 Q
31 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
32 U IO
33 Q
34 ;
35DIVIS ; -- Select Division
36 N X,Y S VAUTD=1,MULTI=0
37 I $P($G(^DG(43,1,"GL")),"^",2) S MULTI=1 D DIVISION^VAUTOMA S:Y=-1 IBQUIT=1
38 I 'VAUTD S X="" F S X=$O(VAUTD(X)) Q:'X S ^TMP($J,"IBCS",$P($G(^DG(40.8,+X,0)),"^"))=""
39 Q
Note: See TracBrowser for help on using the repository browser.