source: WorldVistAEHR/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDFFV.m

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

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1IBDFFV ;ALB/CMR - AICS FORM VALIDATION ; NOV 22,1995
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;**51**;APR 24, 1997
3 ;
4 ; -- displays Form Definition values for validation
5 ;
6 W !,?4,"** This option is OUT OF ORDER **" QUIT ;Code set Versioning
7 ;
8 N IBDFL,X,Y,I,POP,CALL
9 W !!,"AICS Form Validation Report",!!
10 S IBDFL=0 ;flag
11 D SORT G:IBDFL EXIT
12 D DEVICE G:IBDFL EXIT
13DQ ; -- entry point from task man
14 N IBDFL
15 K ^TMP($J,"IBFV"),^TMP($J,"IBDF","UC")
16 S IBDFL=0
17 D ^IBDFFV1
18 I '$D(^TMP($J,"IBFV")) U IO W $C(7),!,"No forms found!" G EXIT
19 D ^IBDFFV2 G EXIT:$G(IBDFOUT)
20 I $D(^TMP($J,"IBDF","UC")) D
21 .N SORT,FORM,CLIN,HEADER
22 .S SORT=$O(^TMP($J,"IBDF","UC","")) Q:SORT']""
23 .D HDR
24 .I SORT="F" S FORM="" F S FORM=$O(^TMP($J,"IBDF","UC",SORT,FORM)) Q:FORM']""!($G(IBDFOUT)) D PG(2) Q:$G(IBDFOUT) W !?5,FORM
25 .I SORT="C" S CLIN="" F S CLIN=$O(^TMP($J,"IBDF","UC",SORT,CLIN)) Q:CLIN']""!($G(IBDFOUT)) D PG(5) Q:$G(IBDFOUT) W !!,"CLINIC: ",CLIN D
26 ..S FORM="" F S FORM=$O(^TMP($J,"IBDF","UC",SORT,CLIN,FORM)) Q:FORM']""!($G(IBDFOUT)) D PG(2) Q:$G(IBDFOUT) W !?5,FORM
27 .I SORT="D"!(SORT="G") S HEADER="" F S HEADER=$O(^TMP($J,"IBDF","UC",SORT,HEADER)) Q:HEADER']""!($G(IBDFOUT)) D PG(7) Q:$G(IBDFOUT) W !!,$S(SORT="G":"GROUP",1:"DIVISION"),": ",HEADER D
28 ..S CLIN="" F S CLIN=$O(^TMP($J,"IBDF","UC",SORT,HEADER,CLIN)) Q:CLIN']""!($G(IBDFOUT)) D PG(5) Q:$G(IBDFOUT) W !!?5,"CLINIC: ",CLIN D
29 ...S FORM="" F S FORM=$O(^TMP($J,"IBDF","UC",SORT,HEADER,CLIN,FORM)) Q:FORM']""!($G(IBDFOUT)) D PG(2) Q:$G(IBDFOUT) W !?10,FORM
30EXIT ; -- Clean up and quit
31 K ^TMP($J,"IBDF","UC"),^TMP($J,"IBFV")
32 I $D(ZTQUEUED) S ZTREQ="@" Q
33 D ^%ZISC
34 K ZTSK,ZTDESC,ZTSAVE,ZTRTN,VAUTF,VAUTG,VAUTC,VAUTD,SORT,IBDFOUT
35 Q
36SORT ; -- determine sort criteria
37 S DIR(0)="S^1:FORM;2:CLINIC;3:GROUP;4:DIVISION",DIR("A")="Validate forms by" D ^DIR K DIR
38 I $D(DIRUT) S IBDFL=1 Q
39 S SORT=Y_U_Y(0),CALL=$S(Y=2:"CLIN",Y=4:"DIV",1:Y(0))
40 ; -- gather selections for sort chosen
41 D @CALL^IBDFUTL
42 Q
43DEVICE ; -- ask device
44 S %ZIS="MQ" D ^%ZIS I POP S IBDLF=1 Q
45 I $D(IO("Q")) S ZTRTN="DQ^IBDFFV",ZTDESC="AICS - Form Validation Report",ZTSAVE("VA*")="",ZTSAVE("SORT")="" D ^%ZTLOAD W !,$S($D(ZTSK):"Request Queued Task="_ZTSK,1:"Request Canceled") D HOME^%ZIS S IBDFL=1 Q
46 U IO
47 Q
48PG(LEN) ; -- check page length
49 ; -- LEN equal to length to check for (optional)...will default
50 I '$D(LEN) S LEN=2
51 Q:$Y+LEN<IOSL
52 I $E(IOST,1,2)["C-" S DIR(0)="E" D ^DIR K DIR,DIRUT,DUOUT,DTOUT I 'Y S IBDFOUT=1 Q
53 W @IOF
54HDR ; -- write out uncompiled forms header
55 W !,$$CJ^XLFSTR("ENCOUNTER FORM VALIDATION",IOM)
56 W !,$$CJ^XLFSTR("REPORT OF UNCOMPILED FORMS",IOM)
57 W !!!,"Validation can only be performed on compiled forms. To compile a form,",!,"you simply print it."
58 W !!!,"The following forms were found to be uncompiled:"
59 Q
Note: See TracBrowser for help on using the repository browser.