IBDFFV2 ;ALB/CMR - AICS FORM VALIDATION ; NOV 27,1995
;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
;
; -- entry point from IBDFFV
; -- called to print out data validation
;
Q:'$D(^TMP($J,"IBFV"))
W:IOST["C-" @IOF
N SORT,DOT
S DOT=".",$P(DOT,".",35)=".",SORT=$O(^TMP($J,"IBFV","")) Q:SORT']""
; -- if sorted by form, gather forms to print
I SORT="F" N FORM,TYPE,FRM,WRITE D Q
.S TYPE=$P($T(TYPE+1),";;",2)
.S FORM="" F S FORM=$O(^TMP($J,"IBFV",SORT,FORM)) Q:FORM']""!($G(IBDFOUT)) S FRM=0 F S FRM=$O(^TMP($J,"IBFV",SORT,FORM,FRM)) Q:'FRM!($G(IBDFOUT)) D PRINT^IBDFFV3(FRM,FORM) I '$G(WRITE) D
..S ^TMP($J,"IBDF","UC",SORT,FORM)=""
; -- if sorted by clinic, gather clinics
I SORT="C" N CLIN,SETUP,CL,DG D Q
.S CLIN="" F S CLIN=$O(^TMP($J,"IBFV",SORT,CLIN)) Q:CLIN']""!($G(IBDFOUT)) S CL="CLINIC: .."_DOT_" "_CLIN,DG="",SETUP=0 F S SETUP=$O(^TMP($J,"IBFV",SORT,CLIN,SETUP)) Q:'SETUP!($G(IBDFOUT)) D CLIN
; -- if sorted by group, gather groups or divisions and clinics
I SORT="G"!(SORT="D") N HEADER,CLIN,SETUP,CL,DG D Q
.S HEADER="" F S HEADER=$O(^TMP($J,"IBFV",SORT,HEADER)) Q:HEADER']""!($G(IBDFOUT)) D
..S CLIN="" F S CLIN=$O(^TMP($J,"IBFV",SORT,HEADER,CLIN)) Q:CLIN']""!($G(IBDFOUT)) D
...S DG=$S(SORT="G":"GROUP: ...",SORT="D":"DIVISION: ",1:"")
...I DG]"" S DG=DG_DOT_" "_HEADER
...S CL="CLINIC: .."_DOT_" "_CLIN
...S SETUP=0 F S SETUP=$O(^TMP($J,"IBFV",SORT,HEADER,CLIN,SETUP)) Q:'SETUP!($G(IBDFOUT)) D CLIN
Q
CLIN ; -- gather forms for clinics
N NODE,TYPE,FRM,CHECK,WRITE,NAME
S NODE=$G(^SD(409.95,SETUP,0))
F I=2:1:9 S FRM=$P(NODE,U,I) I FRM D PRINT^IBDFFV3(FRM,.NAME,I,CL,DG) Q:$G(IBDFOUT) I '$D(WRITE) D
.I SORT="C" S ^TMP($J,"IBDF","UC",SORT,CLIN,NAME)="" Q
.S ^TMP($J,"IBDF","UC",SORT,HEADER,CLIN,NAME)=""
Q
IBDFFV2 ;ALB/CMR - AICS FORM VALIDATION ; NOV 27,1995
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
+2 ;
+3 ; -- entry point from IBDFFV
+4 ; -- called to print out data validation
+5 ;
+6 IF '$DATA(^TMP($JOB,"IBFV"))
QUIT
+7 IF IOST["C-"
WRITE @IOF
+8 NEW SORT,DOT
+9 SET DOT="."
SET $PIECE(DOT,".",35)="."
SET SORT=$ORDER(^TMP($JOB,"IBFV",""))
IF SORT']""
QUIT
+10 ; -- if sorted by form, gather forms to print
+11 IF SORT="F"
NEW FORM,TYPE,FRM,WRITE
Begin DoDot:1
+12 SET TYPE=$PIECE($TEXT(TYPE+1),";;",2)
+13 SET FORM=""
FOR
SET FORM=$ORDER(^TMP($JOB,"IBFV",SORT,FORM))
IF FORM']""!($GET(IBDFOUT))
QUIT
SET FRM=0
FOR
SET FRM=$ORDER(^TMP($JOB,"IBFV",SORT,FORM,FRM))
IF 'FRM!($GET(IBDFOUT))
QUIT
DO PRINT^IBDFFV3(FRM,FORM)
IF '$GET(WRITE)
Begin DoDot:2
+14 SET ^TMP($JOB,"IBDF","UC",SORT,FORM)=""
End DoDot:2
End DoDot:1
QUIT
+15 ; -- if sorted by clinic, gather clinics
+16 IF SORT="C"
NEW CLIN,SETUP,CL,DG
Begin DoDot:1
+17 SET CLIN=""
FOR
SET CLIN=$ORDER(^TMP($JOB,"IBFV",SORT,CLIN))
IF CLIN']""!($GET(IBDFOUT))
QUIT
SET CL="CLINIC: .."_DOT_" "_CLIN
SET DG=""
SET SETUP=0
FOR
SET SETUP=$ORDER(^TMP($JOB,"IBFV",SORT,CLIN,SETUP))
IF 'SETUP!($GET(IBDFOUT))
QUIT
DO CLIN
End DoDot:1
QUIT
+18 ; -- if sorted by group, gather groups or divisions and clinics
+19 IF SORT="G"!(SORT="D")
NEW HEADER,CLIN,SETUP,CL,DG
Begin DoDot:1
+20 SET HEADER=""
FOR
SET HEADER=$ORDER(^TMP($JOB,"IBFV",SORT,HEADER))
IF HEADER']""!($GET(IBDFOUT))
QUIT
Begin DoDot:2
+21 SET CLIN=""
FOR
SET CLIN=$ORDER(^TMP($JOB,"IBFV",SORT,HEADER,CLIN))
IF CLIN']""!($GET(IBDFOUT))
QUIT
Begin DoDot:3
+22 SET DG=$SELECT(SORT="G":"GROUP: ...",SORT="D":"DIVISION: ",1:"")
+23 IF DG]""
SET DG=DG_DOT_" "_HEADER
+24 SET CL="CLINIC: .."_DOT_" "_CLIN
+25 SET SETUP=0
FOR
SET SETUP=$ORDER(^TMP($JOB,"IBFV",SORT,HEADER,CLIN,SETUP))
IF 'SETUP!($GET(IBDFOUT))
QUIT
DO CLIN
End DoDot:3
End DoDot:2
End DoDot:1
QUIT
+26 QUIT
CLIN ; -- gather forms for clinics
+1 NEW NODE,TYPE,FRM,CHECK,WRITE,NAME
+2 SET NODE=$GET(^SD(409.95,SETUP,0))
+3 FOR I=2:1:9
SET FRM=$PIECE(NODE,U,I)
IF FRM
DO PRINT^IBDFFV3(FRM,.NAME,I,CL,DG)
IF $GET(IBDFOUT)
QUIT
IF '$DATA(WRITE)
Begin DoDot:1
+4 IF SORT="C"
SET ^TMP($JOB,"IBDF","UC",SORT,CLIN,NAME)=""
QUIT
+5 SET ^TMP($JOB,"IBDF","UC",SORT,HEADER,CLIN,NAME)=""
End DoDot:1
+6 QUIT
