source: FOIAVistA/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDF1B1B.m@ 1800

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

initial load of FOIAVistA 6/30/08 version

File size: 1.3 KB
Line 
1IBDF1B1B ;ALB/CJM - ENCOUNTER FORM PRINT (IBDF1B continued - user options for printing- continuation of IBDF1B1); 3/1/93
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
3 ;
4ENDV ;entire divisions were choosen, find all clinics (with encounter forms defined)
5 N IBCLN,IBDIV,NODE,DIVISION,ALL
6 ;
7 ;if ^TMP("IBDF",$J,"D","ALL") exists then all divisions were chosen
8 S ALL=$S($D(^TMP("IBDF",$J,"D","ALL")):1,1:0)
9 ;
10 ;user did not select ALL, so make a list of the divisions he did choose
11 I 'ALL S IBDIV=0 F S IBDIV=$O(^TMP("IBDF",$J,"D",IBDIV)) Q:'IBDIV S DIVISION(IBDIV)=""
12 ;
13 ;loop through all the clinics finding ones in selected divisions
14 S IBCLN="" F S IBCLN=$O(^SC(IBCLN)) Q:IBCLN="" D
15 .S NODE=$G(^SC(IBCLN,0))
16 .;
17 .;make sure it's in one of the selected divisions
18 .S IBDIV=$P(NODE,"^",15)
19 .I IBDIV,'ALL Q:'$D(DIVISION(IBDIV))
20 .;
21 .;check that location is a clinic
22 .Q:$P(NODE,"^",3)'="C"
23 .;
24 .;if it's a restart make sure the IBDIV does not precede the starting division
25 .I IBSTRTDV]" ",IBDIV S DIVISION=$P($G(^DG(40.8,IBDIV,0)),"^") I DIVISION'=IBSTRTDV,DIVISION']IBSTRTDV Q
26 .;
27 .;don't put it on the list if there is nothing to print
28 .I '$$DIVHAS^IBDF1B1A(IBDIV),'$$CLNCHAS^IBDF1B1A(IBCLN) Q
29 .;
30 .;it passed all the tests, put it on the list
31 .S ^TMP("IBDF",$J,"C",IBCLN)=""
32 ;
33 ;don't need list of divisions anymore
34 K ^TMP("IBDF",$J,"D")
35 Q
Note: See TracBrowser for help on using the repository browser.