PSJQUTIL ;BIR/RMS-UTILITY FOR PATIENTS ON SPECIFIC DRUGS ; 7/6/09 2:19pm
;;5.0; INPATIENT MEDICATIONS ;**214**;16 DEC 97;Build 8
;
;Reference to ^DIC(42 is supported by DBIA# 1377
;
CNTDIV() ;COUNT THE NUMBER OF DIVISIONS PRESENT FOR WARD LOCATIONS
N WARD,DIV,DIVCT,DIVARR
S WARD=0 F S WARD=$O(^DIC(42,WARD)) Q:'+WARD D
. S DIV=$P($G(^DIC(42,WARD,0)),U,11)
. I +DIV S DIVARR(DIV)=""
S (DIV,DIVCT)=0 F S DIV=$O(DIVARR(DIV)) Q:'+DIV D
. S DIVCT=DIVCT+1
Q DIVCT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJQUTIL 489 printed Nov 22, 2024@17:19:06 Page 2
PSJQUTIL ;BIR/RMS-UTILITY FOR PATIENTS ON SPECIFIC DRUGS ; 7/6/09 2:19pm
+1 ;;5.0; INPATIENT MEDICATIONS ;**214**;16 DEC 97;Build 8
+2 ;
+3 ;Reference to ^DIC(42 is supported by DBIA# 1377
+4 ;
CNTDIV() ;COUNT THE NUMBER OF DIVISIONS PRESENT FOR WARD LOCATIONS
+1 NEW WARD,DIV,DIVCT,DIVARR
+2 SET WARD=0
FOR
SET WARD=$ORDER(^DIC(42,WARD))
if '+WARD
QUIT
Begin DoDot:1
+3 SET DIV=$PIECE($GET(^DIC(42,WARD,0)),U,11)
+4 IF +DIV
SET DIVARR(DIV)=""
End DoDot:1
+5 SET (DIV,DIVCT)=0
FOR
SET DIV=$ORDER(DIVARR(DIV))
if '+DIV
QUIT
Begin DoDot:1
+6 SET DIVCT=DIVCT+1
End DoDot:1
+7 QUIT DIVCT
