TIUUTL2 ;AITC/CR - UTILITY FOR INPT MULTIDIVISONAL ROUTINES ;10/18/17 9:29am
;;1.0;TEXT INTEGRATION UTILITIES;**305**;JUN 20, 1997;Build 27
;
; Reference to ^DIC(42 - supported by ICR #10039
;
CNTDIV() ;COUNT THE NUMBER OF DIVISIONS PRESENT FOR WARD LOCATIONS
N TIUWARD,TIUDIV,TIUDIVCT,TIUDIVARR
S TIUWARD=0 F S TIUWARD=$O(^DIC(42,TIUWARD)) Q:'+TIUWARD D
. Q:$P($G(^DIC(42,TIUWARD,"OOS",1,0)),U)'="" ; skip over inactive wards
. S TIUDIV=$P($G(^DIC(42,TIUWARD,0)),U,11)
. I +TIUDIV S TIUDIVARR(TIUDIV)=""
S (TIUDIV,TIUDIVCT)=0 F S TIUDIV=$O(TIUDIVARR(TIUDIV)) Q:'+TIUDIV D
. S TIUDIVCT=TIUDIVCT+1
Q TIUDIVCT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUUTL2 641 printed Oct 16, 2024@18:47 Page 2
TIUUTL2 ;AITC/CR - UTILITY FOR INPT MULTIDIVISONAL ROUTINES ;10/18/17 9:29am
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**305**;JUN 20, 1997;Build 27
+2 ;
+3 ; Reference to ^DIC(42 - supported by ICR #10039
+4 ;
CNTDIV() ;COUNT THE NUMBER OF DIVISIONS PRESENT FOR WARD LOCATIONS
+1 NEW TIUWARD,TIUDIV,TIUDIVCT,TIUDIVARR
+2 SET TIUWARD=0
FOR
SET TIUWARD=$ORDER(^DIC(42,TIUWARD))
if '+TIUWARD
QUIT
Begin DoDot:1
+3 ; skip over inactive wards
if $PIECE($GET(^DIC(42,TIUWARD,"OOS",1,0)),U)'=""
QUIT
+4 SET TIUDIV=$PIECE($GET(^DIC(42,TIUWARD,0)),U,11)
+5 IF +TIUDIV
SET TIUDIVARR(TIUDIV)=""
End DoDot:1
+6 SET (TIUDIV,TIUDIVCT)=0
FOR
SET TIUDIV=$ORDER(TIUDIVARR(TIUDIV))
if '+TIUDIV
QUIT
Begin DoDot:1
+7 SET TIUDIVCT=TIUDIVCT+1
End DoDot:1
+8 QUIT TIUDIVCT
