source: WorldVistAEHR/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDFFV1.m@ 1464

Last change on this file since 1464 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.5 KB
RevLine 
[613]1IBDFFV1 ;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
10FORM ; -- $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
16CLINIC ; -- $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
22GROUP ; -- $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
31DIV ; -- $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
42CLIN ; -- 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
Note: See TracBrowser for help on using the repository browser.