PSJQUTIL.m

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 ---PSJQUTIL   489     printed  Apr 09, 2024@21:04:17                                                                                                                                                                                                     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