IBDFFV ;ALB/CMR - AICS FORM VALIDATION ; NOV 22,1995
;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
;
; -- displays Form Definition values for validation
;
N IBDFL,X,Y,I,POP,CALL
W !!,"AICS Form Validation Report",!!
S IBDFL=0 ;flag
D SORT G:IBDFL EXIT
D DEVICE G:IBDFL EXIT
DQ ; -- entry point from task man
N IBDFL
K ^TMP($J,"IBFV"),^TMP($J,"IBDF","UC")
S IBDFL=0
D ^IBDFFV1
I '$D(^TMP($J,"IBFV")) U IO W $C(7),!,"No forms found!" G EXIT
D ^IBDFFV2 G EXIT:$G(IBDFOUT)
I $D(^TMP($J,"IBDF","UC")) D
.N SORT,FORM,CLIN,HEADER
.S SORT=$O(^TMP($J,"IBDF","UC","")) Q:SORT']""
.D HDR
.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
.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
..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
.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
..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
...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
EXIT ; -- Clean up and quit
K ^TMP($J,"IBDF","UC"),^TMP($J,"IBFV")
I $D(ZTQUEUED) S ZTREQ="@" Q
D ^%ZISC
K ZTSK,ZTDESC,ZTSAVE,ZTRTN,VAUTF,VAUTG,VAUTC,VAUTD,SORT,IBDFOUT
Q
SORT ; -- determine sort criteria
S DIR(0)="S^1:FORM;2:CLINIC;3:GROUP;4:DIVISION",DIR("A")="Validate forms by" D ^DIR K DIR
I $D(DIRUT) S IBDFL=1 Q
S SORT=Y_U_Y(0),CALL=$S(Y=2:"CLIN",Y=4:"DIV",1:Y(0))
; -- gather selections for sort chosen
D @CALL^IBDFUTL
Q
DEVICE ; -- ask device
S %ZIS="MQ" D ^%ZIS I POP S IBDLF=1 Q
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
U IO
Q
PG(LEN) ; -- check page length
; -- LEN equal to length to check for (optional)...will default
I '$D(LEN) S LEN=2
Q:$Y+LEN<IOSL
I $E(IOST,1,2)["C-" S DIR(0)="E" D ^DIR K DIR,DIRUT,DUOUT,DTOUT I 'Y S IBDFOUT=1 Q
W @IOF
HDR ; -- write out uncompiled forms header
W !,$$CJ^XLFSTR("ENCOUNTER FORM VALIDATION",IOM)
W !,$$CJ^XLFSTR("REPORT OF UNCOMPILED FORMS",IOM)
W !!!,"Validation can only be performed on compiled forms. To compile a form,",!,"you simply print it."
W !!!,"The following forms were found to be uncompiled:"
Q
IBDFFV ;ALB/CMR - AICS FORM VALIDATION ; NOV 22,1995
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
+2 ;
+3 ; -- displays Form Definition values for validation
+4 ;
+5 NEW IBDFL,X,Y,I,POP,CALL
+6 WRITE !!,"AICS Form Validation Report",!!
+7 ;flag
SET IBDFL=0
+8 DO SORT
IF IBDFL
GOTO EXIT
+9 DO DEVICE
IF IBDFL
GOTO EXIT
DQ ; -- entry point from task man
+1 NEW IBDFL
+2 KILL ^TMP($JOB,"IBFV"),^TMP($JOB,"IBDF","UC")
+3 SET IBDFL=0
+4 DO ^IBDFFV1
+5 IF '$DATA(^TMP($JOB,"IBFV"))
USE IO
WRITE $CHAR(7),!,"No forms found!"
GOTO EXIT
+6 DO ^IBDFFV2
IF $GET(IBDFOUT)
GOTO EXIT
+7 IF $DATA(^TMP($JOB,"IBDF","UC"))
Begin DoDot:1
+8 NEW SORT,FORM,CLIN,HEADER
+9 SET SORT=$ORDER(^TMP($JOB,"IBDF","UC",""))
IF SORT']""
QUIT
+10 DO HDR
+11 IF SORT="F"
SET FORM=""
FOR
SET FORM=$ORDER(^TMP($JOB,"IBDF","UC",SORT,FORM))
IF FORM']""!($GET(IBDFOUT))
QUIT
DO PG(2)
IF $GET(IBDFOUT)
QUIT
WRITE !?5,FORM
+12 IF SORT="C"
SET CLIN=""
FOR
SET CLIN=$ORDER(^TMP($JOB,"IBDF","UC",SORT,CLIN))
IF CLIN']""!($GET(IBDFOUT))
QUIT
DO PG(5)
IF $GET(IBDFOUT)
QUIT
WRITE !!,"CLINIC: ",CLIN
Begin DoDot:2
+13 SET FORM=""
FOR
SET FORM=$ORDER(^TMP($JOB,"IBDF","UC",SORT,CLIN,FORM))
IF FORM']""!($GET(IBDFOUT))
QUIT
DO PG(2)
IF $GET(IBDFOUT)
QUIT
WRITE !?5,FORM
End DoDot:2
+14 IF SORT="D"!(SORT="G")
SET HEADER=""
FOR
SET HEADER=$ORDER(^TMP($JOB,"IBDF","UC",SORT,HEADER))
IF HEADER']""!($GET(IBDFOUT))
QUIT
DO PG(7)
IF $GET(IBDFOUT)
QUIT
WRITE !!,$SELECT(SORT="G":"GROUP",1:"DIVISION"),": ",HEADER
Begin DoDot:2
+15 SET CLIN=""
FOR
SET CLIN=$ORDER(^TMP($JOB,"IBDF","UC",SORT,HEADER,CLIN))
IF CLIN']""!($GET(IBDFOUT))
QUIT
DO PG(5)
IF $GET(IBDFOUT)
QUIT
WRITE !!?5,"CLINIC: ",CLIN
Begin DoDot:3
+16 SET FORM=""
FOR
SET FORM=$ORDER(^TMP($JOB,"IBDF","UC",SORT,HEADER,CLIN,FORM))
IF FORM']""!($GET(IBDFOUT))
QUIT
DO PG(2)
IF $GET(IBDFOUT)
QUIT
WRITE !?10,FORM
End DoDot:3
End DoDot:2
End DoDot:1
EXIT ; -- Clean up and quit
+1 KILL ^TMP($JOB,"IBDF","UC"),^TMP($JOB,"IBFV")
+2 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+3 DO ^%ZISC
+4 KILL ZTSK,ZTDESC,ZTSAVE,ZTRTN,VAUTF,VAUTG,VAUTC,VAUTD,SORT,IBDFOUT
+5 QUIT
SORT ; -- determine sort criteria
+1 SET DIR(0)="S^1:FORM;2:CLINIC;3:GROUP;4:DIVISION"
SET DIR("A")="Validate forms by"
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
SET IBDFL=1
QUIT
+3 SET SORT=Y_U_Y(0)
SET CALL=$SELECT(Y=2:"CLIN",Y=4:"DIV",1:Y(0))
+4 ; -- gather selections for sort chosen
+5 DO @CALL^IBDFUTL
+6 QUIT
DEVICE ; -- ask device
+1 SET %ZIS="MQ"
DO ^%ZIS
IF POP
SET IBDLF=1
QUIT
+2 IF $DATA(IO("Q"))
SET ZTRTN="DQ^IBDFFV"
SET ZTDESC="AICS - Form Validation Report"
SET ZTSAVE("VA*")=""
SET ZTSAVE("SORT")=""
DO ^%ZTLOAD
WRITE !,$SELECT($DATA(ZTSK):"Request Queued Task="_ZTSK,1:"Request Canceled")
DO HOME^%ZIS
SET IBDFL=1
QUIT
+3 USE IO
+4 QUIT
PG(LEN) ; -- check page length
+1 ; -- LEN equal to length to check for (optional)...will default
+2 IF '$DATA(LEN)
SET LEN=2
+3 IF $Y+LEN<IOSL
QUIT
+4 IF $EXTRACT(IOST,1,2)["C-"
SET DIR(0)="E"
DO ^DIR
KILL DIR,DIRUT,DUOUT,DTOUT
IF 'Y
SET IBDFOUT=1
QUIT
+5 WRITE @IOF
HDR ; -- write out uncompiled forms header
+1 WRITE !,$$CJ^XLFSTR("ENCOUNTER FORM VALIDATION",IOM)
+2 WRITE !,$$CJ^XLFSTR("REPORT OF UNCOMPILED FORMS",IOM)
+3 WRITE !!!,"Validation can only be performed on compiled forms. To compile a form,",!,"you simply print it."
+4 WRITE !!!,"The following forms were found to be uncompiled:"
+5 QUIT
