IBDF1B1B ;ALB/CJM - ENCOUNTER FORM PRINT (IBDF1B continued - user options for printing- continuation of IBDF1B1); 3/1/93
;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
;
ENDV ;entire divisions were choosen, find all clinics (with encounter forms defined)
N IBCLN,IBDIV,NODE,DIVISION,ALL
;
;if ^TMP("IBDF",$J,"D","ALL") exists then all divisions were chosen
S ALL=$S($D(^TMP("IBDF",$J,"D","ALL")):1,1:0)
;
;user did not select ALL, so make a list of the divisions he did choose
I 'ALL S IBDIV=0 F S IBDIV=$O(^TMP("IBDF",$J,"D",IBDIV)) Q:'IBDIV S DIVISION(IBDIV)=""
;
;loop through all the clinics finding ones in selected divisions
S IBCLN="" F S IBCLN=$O(^SC(IBCLN)) Q:IBCLN="" D
.S NODE=$G(^SC(IBCLN,0))
.;
.;make sure it's in one of the selected divisions
.S IBDIV=$P(NODE,"^",15)
.I IBDIV,'ALL Q:'$D(DIVISION(IBDIV))
.;
.;check that location is a clinic
.Q:$P(NODE,"^",3)'="C"
.;
.;if it's a restart make sure the IBDIV does not precede the starting division
.I IBSTRTDV]" ",IBDIV S DIVISION=$P($G(^DG(40.8,IBDIV,0)),"^") I DIVISION'=IBSTRTDV,DIVISION']IBSTRTDV Q
.;
.;don't put it on the list if there is nothing to print
.I '$$DIVHAS^IBDF1B1A(IBDIV),'$$CLNCHAS^IBDF1B1A(IBCLN) Q
.;
.;it passed all the tests, put it on the list
.S ^TMP("IBDF",$J,"C",IBCLN)=""
;
;don't need list of divisions anymore
K ^TMP("IBDF",$J,"D")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDF1B1B 1404 printed Dec 13, 2024@02:51:06 Page 2
IBDF1B1B ;ALB/CJM - ENCOUNTER FORM PRINT (IBDF1B continued - user options for printing- continuation of IBDF1B1); 3/1/93
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
+2 ;
ENDV ;entire divisions were choosen, find all clinics (with encounter forms defined)
+1 NEW IBCLN,IBDIV,NODE,DIVISION,ALL
+2 ;
+3 ;if ^TMP("IBDF",$J,"D","ALL") exists then all divisions were chosen
+4 SET ALL=$SELECT($DATA(^TMP("IBDF",$JOB,"D","ALL")):1,1:0)
+5 ;
+6 ;user did not select ALL, so make a list of the divisions he did choose
+7 IF 'ALL
SET IBDIV=0
FOR
SET IBDIV=$ORDER(^TMP("IBDF",$JOB,"D",IBDIV))
if 'IBDIV
QUIT
SET DIVISION(IBDIV)=""
+8 ;
+9 ;loop through all the clinics finding ones in selected divisions
+10 SET IBCLN=""
FOR
SET IBCLN=$ORDER(^SC(IBCLN))
if IBCLN=""
QUIT
Begin DoDot:1
+11 SET NODE=$GET(^SC(IBCLN,0))
+12 ;
+13 ;make sure it's in one of the selected divisions
+14 SET IBDIV=$PIECE(NODE,"^",15)
+15 IF IBDIV
IF 'ALL
if '$DATA(DIVISION(IBDIV))
QUIT
+16 ;
+17 ;check that location is a clinic
+18 if $PIECE(NODE,"^",3)'="C"
QUIT
+19 ;
+20 ;if it's a restart make sure the IBDIV does not precede the starting division
+21 IF IBSTRTDV]" "
IF IBDIV
SET DIVISION=$PIECE($GET(^DG(40.8,IBDIV,0)),"^")
IF DIVISION'=IBSTRTDV
IF DIVISION']IBSTRTDV
QUIT
+22 ;
+23 ;don't put it on the list if there is nothing to print
+24 IF '$$DIVHAS^IBDF1B1A(IBDIV)
IF '$$CLNCHAS^IBDF1B1A(IBCLN)
QUIT
+25 ;
+26 ;it passed all the tests, put it on the list
+27 SET ^TMP("IBDF",$JOB,"C",IBCLN)=""
End DoDot:1
+28 ;
+29 ;don't need list of divisions anymore
+30 KILL ^TMP("IBDF",$JOB,"D")
+31 QUIT
