- 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 Jan 18, 2025@03:47:33 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