- 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 Feb 19, 2025@00:17:31 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
