[613] | 1 | IBDF1B1B ;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 | ;
|
---|
| 4 | ENDV ;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
|
---|