IBDFFV1 ;ALB/CMR - AICS FORM VALIDATION ; NOV 24,1995
;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
;
; -- entry point from IBDFFV
; -- called to set up ^TMP with forms to be printed
;
Q:('$D(VAUTD)&('$D(VAUTG))&('$D(VAUTC))&('$D(VAUTF)))!('$D(SORT))
D FORM:+SORT=1,CLINIC:+SORT=2,GROUP:+SORT=3,DIV:+SORT=4
Q
FORM ; -- $O through forms
;
N FRM,FORM
Q:'$D(VAUTF)
S FRM=0 F S FRM=$S(VAUTF:$O(^IBE(357,FRM)),1:$O(VAUTF(FRM))) Q:'FRM S FORM=$P($G(^IBE(357,FRM,0)),U) I FORM]"" S ^TMP($J,"IBFV","F",FORM,FRM)=""
Q
CLINIC ; -- $O through clinics
;
N CLIN
Q:'$D(VAUTC)
S CLIN=0 F S CLIN=$S(VAUTC:$O(^SD(409.95,"B",CLIN)),1:$O(VAUTC(CLIN))) Q:'CLIN D CLIN
Q
GROUP ; -- $O through groups
;
N GRP,GROUP,CLIN
Q:'$D(VAUTG)
S GRP=0 F S GRP=$S(VAUTG:$O(^IBD(357.99,GRP)),1:$O(VAUTG(GRP))) Q:'GRP D
.S GROUP=$P($G(^IBD(357.99,GRP,0)),U)
.; -- find all clinics associated with group
.S CLIN=0 F S CLIN=$O(^IBD(357.99,GRP,10,"B",CLIN)) Q:'CLIN D CLIN
Q
DIV ; -- $O through divisions
;
N CLIN,DIV
Q:'$D(VAUTD)
S CLIN="" F S CLIN=$O(^SD(409.95,"B",CLIN)) Q:'CLIN D
.S DIV=$P($G(^SC(CLIN,0)),U,15) Q:'DIV
.; -- quit if division for clinic is not a chosen division
.I 'VAUTD,'$D(VAUTD(DIV)) Q
.S:+DIV DIV=$P($G(^DG(40.8,+DIV,0)),U) Q:DIV']""
.D CLIN
Q
CLIN ; -- set up TMP nodes
N SETUP,NAME
S SETUP=$O(^SD(409.95,"B",CLIN,"")) Q:'SETUP
S NAME=$P($G(^SC(CLIN,0)),U) Q:NAME=""
I +SORT=2 S ^TMP($J,"IBFV","C",NAME,SETUP)="" Q
I +SORT=3 S ^TMP($J,"IBFV","G",GROUP,NAME,SETUP)="" Q
I +SORT=4 S ^TMP($J,"IBFV","D",DIV,NAME,SETUP)="" Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDFFV1 1617 printed Dec 13, 2024@02:52:38 Page 2
IBDFFV1 ;ALB/CMR - AICS FORM VALIDATION ; NOV 24,1995
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
+2 ;
+3 ; -- entry point from IBDFFV
+4 ; -- called to set up ^TMP with forms to be printed
+5 ;
+6 if ('$DATA(VAUTD)&('$DATA(VAUTG))&('$DATA(VAUTC))&('$DATA(VAUTF)))!('$DATA(SORT))
QUIT
+7 if +SORT=1
DO FORM
if +SORT=2
DO CLINIC
if +SORT=3
DO GROUP
if +SORT=4
DO DIV
+8 QUIT
FORM ; -- $O through forms
+1 ;
+2 NEW FRM,FORM
+3 if '$DATA(VAUTF)
QUIT
+4 SET FRM=0
FOR
SET FRM=$SELECT(VAUTF:$ORDER(^IBE(357,FRM)),1:$ORDER(VAUTF(FRM)))
if 'FRM
QUIT
SET FORM=$PIECE($GET(^IBE(357,FRM,0)),U)
IF FORM]""
SET ^TMP($JOB,"IBFV","F",FORM,FRM)=""
+5 QUIT
CLINIC ; -- $O through clinics
+1 ;
+2 NEW CLIN
+3 if '$DATA(VAUTC)
QUIT
+4 SET CLIN=0
FOR
SET CLIN=$SELECT(VAUTC:$ORDER(^SD(409.95,"B",CLIN)),1:$ORDER(VAUTC(CLIN)))
if 'CLIN
QUIT
DO CLIN
+5 QUIT
GROUP ; -- $O through groups
+1 ;
+2 NEW GRP,GROUP,CLIN
+3 if '$DATA(VAUTG)
QUIT
+4 SET GRP=0
FOR
SET GRP=$SELECT(VAUTG:$ORDER(^IBD(357.99,GRP)),1:$ORDER(VAUTG(GRP)))
if 'GRP
QUIT
Begin DoDot:1
+5 SET GROUP=$PIECE($GET(^IBD(357.99,GRP,0)),U)
+6 ; -- find all clinics associated with group
+7 SET CLIN=0
FOR
SET CLIN=$ORDER(^IBD(357.99,GRP,10,"B",CLIN))
if 'CLIN
QUIT
DO CLIN
End DoDot:1
+8 QUIT
DIV ; -- $O through divisions
+1 ;
+2 NEW CLIN,DIV
+3 if '$DATA(VAUTD)
QUIT
+4 SET CLIN=""
FOR
SET CLIN=$ORDER(^SD(409.95,"B",CLIN))
if 'CLIN
QUIT
Begin DoDot:1
+5 SET DIV=$PIECE($GET(^SC(CLIN,0)),U,15)
if 'DIV
QUIT
+6 ; -- quit if division for clinic is not a chosen division
+7 IF 'VAUTD
IF '$DATA(VAUTD(DIV))
QUIT
+8 if +DIV
SET DIV=$PIECE($GET(^DG(40.8,+DIV,0)),U)
if DIV']""
QUIT
+9 DO CLIN
End DoDot:1
+10 QUIT
CLIN ; -- set up TMP nodes
+1 NEW SETUP,NAME
+2 SET SETUP=$ORDER(^SD(409.95,"B",CLIN,""))
if 'SETUP
QUIT
+3 SET NAME=$PIECE($GET(^SC(CLIN,0)),U)
if NAME=""
QUIT
+4 IF +SORT=2
SET ^TMP($JOB,"IBFV","C",NAME,SETUP)=""
QUIT
+5 IF +SORT=3
SET ^TMP($JOB,"IBFV","G",GROUP,NAME,SETUP)=""
QUIT
+6 IF +SORT=4
SET ^TMP($JOB,"IBFV","D",DIV,NAME,SETUP)=""
QUIT
+7 QUIT
