| [613] | 1 | IBDF15 ;ALB/CJM - AICS FORM USE BY DIVISION/CLINIC ; JUL 20,1993
|
|---|
| 2 | ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | FORMUSE ; -- 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 | ;
|
|---|
| 14 | EXIT ; -- 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 | ;
|
|---|
| 20 | DQ ; -- 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 | ;
|
|---|
| 27 | DEVICE ; -- 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 | ;
|
|---|
| 33 | DIVIS ; -- 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
|
|---|
