| 1 | IBDFFV1 ;ALB/CMR - AICS FORM VALIDATION ; NOV 24,1995
|
|---|
| 2 | ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | ; -- entry point from IBDFFV
|
|---|
| 5 | ; -- called to set up ^TMP with forms to be printed
|
|---|
| 6 | ;
|
|---|
| 7 | Q:('$D(VAUTD)&('$D(VAUTG))&('$D(VAUTC))&('$D(VAUTF)))!('$D(SORT))
|
|---|
| 8 | D FORM:+SORT=1,CLINIC:+SORT=2,GROUP:+SORT=3,DIV:+SORT=4
|
|---|
| 9 | Q
|
|---|
| 10 | FORM ; -- $O through forms
|
|---|
| 11 | ;
|
|---|
| 12 | N FRM,FORM
|
|---|
| 13 | Q:'$D(VAUTF)
|
|---|
| 14 | 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)=""
|
|---|
| 15 | Q
|
|---|
| 16 | CLINIC ; -- $O through clinics
|
|---|
| 17 | ;
|
|---|
| 18 | N CLIN
|
|---|
| 19 | Q:'$D(VAUTC)
|
|---|
| 20 | S CLIN=0 F S CLIN=$S(VAUTC:$O(^SD(409.95,"B",CLIN)),1:$O(VAUTC(CLIN))) Q:'CLIN D CLIN
|
|---|
| 21 | Q
|
|---|
| 22 | GROUP ; -- $O through groups
|
|---|
| 23 | ;
|
|---|
| 24 | N GRP,GROUP,CLIN
|
|---|
| 25 | Q:'$D(VAUTG)
|
|---|
| 26 | S GRP=0 F S GRP=$S(VAUTG:$O(^IBD(357.99,GRP)),1:$O(VAUTG(GRP))) Q:'GRP D
|
|---|
| 27 | .S GROUP=$P($G(^IBD(357.99,GRP,0)),U)
|
|---|
| 28 | .; -- find all clinics associated with group
|
|---|
| 29 | .S CLIN=0 F S CLIN=$O(^IBD(357.99,GRP,10,"B",CLIN)) Q:'CLIN D CLIN
|
|---|
| 30 | Q
|
|---|
| 31 | DIV ; -- $O through divisions
|
|---|
| 32 | ;
|
|---|
| 33 | N CLIN,DIV
|
|---|
| 34 | Q:'$D(VAUTD)
|
|---|
| 35 | S CLIN="" F S CLIN=$O(^SD(409.95,"B",CLIN)) Q:'CLIN D
|
|---|
| 36 | .S DIV=$P($G(^SC(CLIN,0)),U,15) Q:'DIV
|
|---|
| 37 | .; -- quit if division for clinic is not a chosen division
|
|---|
| 38 | .I 'VAUTD,'$D(VAUTD(DIV)) Q
|
|---|
| 39 | .S:+DIV DIV=$P($G(^DG(40.8,+DIV,0)),U) Q:DIV']""
|
|---|
| 40 | .D CLIN
|
|---|
| 41 | Q
|
|---|
| 42 | CLIN ; -- set up TMP nodes
|
|---|
| 43 | N SETUP,NAME
|
|---|
| 44 | S SETUP=$O(^SD(409.95,"B",CLIN,"")) Q:'SETUP
|
|---|
| 45 | S NAME=$P($G(^SC(CLIN,0)),U) Q:NAME=""
|
|---|
| 46 | I +SORT=2 S ^TMP($J,"IBFV","C",NAME,SETUP)="" Q
|
|---|
| 47 | I +SORT=3 S ^TMP($J,"IBFV","G",GROUP,NAME,SETUP)="" Q
|
|---|
| 48 | I +SORT=4 S ^TMP($J,"IBFV","D",DIV,NAME,SETUP)="" Q
|
|---|
| 49 | Q
|
|---|
