| [613] | 1 | IBDFFV ;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
|
|---|
| 13 | DQ ; -- 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
|
|---|
| 30 | EXIT ; -- 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
|
|---|
| 36 | SORT ; -- 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
|
|---|
| 43 | DEVICE ; -- 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
|
|---|
| 48 | PG(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
|
|---|
| 54 | HDR ; -- 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
|
|---|
