- 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
- 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
