- 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
