XBHEDD3.m

XBHEDD3 ;402,DJB,10/23/91,EDD - Individual Field Summary

 ;;2.6;IHS UTILITIES;;JUN 28, 1993

 ;;David Bolduc - Togus,ME

 N CNT,DATA,FILE,FNAM,FNUM,LEV,TEMP

 D INIT I FLAGP D HD

 F  D GETFLD Q:'LEV!FLAGE

 I FLAGP,$D(^UTILITY($J,"INDIV")) D PRINT

EX ;

 K DIC,^UTILITY($J,"INDIV") S FLAGQ=1 Q

GETFLD ;Field lookup. Var LEV increments and decrements with Multiple layers.

 S DIC="^DD("_FILE(LEV)_"," D ^DIC I Y<0 S LEV=LEV-1 Q

 S FNUM=+Y,FNAM=$P(Y,U,2),TEMP=+$P(^DD(FILE(LEV),FNUM,0),U,2)

 I TEMP S LEV=LEV+1,FILE(LEV)=TEMP Q

 I 'FLAGP D ^XBHEDD4 Q

 S ^UTILITY($J,"INDIV",CNT)=FILE(LEV)_"^"_FNUM_"^"_FNAM,CNT=CNT+1

 Q

PRINT ;

 W:IO'=IO(0) "  Printing.." U IO D TXT^XBHEDD7

 S CNT="" F  S CNT=$O(^UTILITY($J,"INDIV",CNT)) Q:CNT=""  S DATA=^UTILITY($J,"INDIV",CNT),FILE(LEV)=$P(DATA,U),FNUM=$P(DATA,U,2),FNAM=$P(DATA,U,3) D ^XBHEDD4 Q:FLAGQ  W !!,$E(ZLINE2,1,IOM),!!

 Q

HD ;

 W @IOF,!,$E(ZLINE1,1,80),!?5,"Enter one at a time, as many fields as you wish to print. Fields will",!?5,"print in the order entered.",!,$E(ZLINE1,1,80),!

 Q

INIT ;

 S (CNT,LEV)=1,FILE(LEV)=ZNUM K ^UTILITY($J,"INDIV")

 S DIC(0)="QEAM",DIC("W")="I $P(^DD(FILE(LEV),Y,0),U,2)>0 W ""    -->Mult Fld"""

 Q

XBHEDD3   ;402,DJB,10/23/91,EDD - Individual Field Summary

 +1       ;;2.6;IHS UTILITIES;;JUN 28, 1993

 +2       ;;David Bolduc - Togus,ME

 +3        NEW CNT,DATA,FILE,FNAM,FNUM,LEV,TEMP

 +4        DO INIT

           IF FLAGP

               DO HD

 +5        FOR 

               DO GETFLD

               IF 'LEV!FLAGE

                   QUIT 

 +6        IF FLAGP

               IF $DATA(^UTILITY($JOB,"INDIV"))

                   DO PRINT

EX        ;

 +1        KILL DIC,^UTILITY($JOB,"INDIV")

           SET FLAGQ=1

           QUIT 

GETFLD    ;Field lookup. Var LEV increments and decrements with Multiple layers.

 +1        SET DIC="^DD("_FILE(LEV)_","

           DO ^DIC

           IF Y<0

               SET LEV=LEV-1

               QUIT 

 +2        SET FNUM=+Y

           SET FNAM=$PIECE(Y,U,2)

           SET TEMP=+$PIECE(^DD(FILE(LEV),FNUM,0),U,2)

 +3        IF TEMP

               SET LEV=LEV+1

               SET FILE(LEV)=TEMP

               QUIT 

 +4        IF 'FLAGP

               DO ^XBHEDD4

               QUIT 

 +5        SET ^UTILITY($JOB,"INDIV",CNT)=FILE(LEV)_"^"_FNUM_"^"_FNAM

           SET CNT=CNT+1

 +6        QUIT 

PRINT     ;

 +1        IF IO'=IO(0)

               WRITE "  Printing.."

           USE IO

           DO TXT^XBHEDD7

 +2        SET CNT=""

           FOR 

               SET CNT=$ORDER(^UTILITY($JOB,"INDIV",CNT))

               IF CNT=""

                   QUIT 

               SET DATA=^UTILITY($JOB,"INDIV",CNT)

               SET FILE(LEV)=$PIECE(DATA,U)

               SET FNUM=$PIECE(DATA,U,2)

               SET FNAM=$PIECE(DATA,U,3)

               DO ^XBHEDD4

               IF FLAGQ

                   QUIT 

               WRITE !!,$EXTRACT(ZLINE2,1,IOM),!!

 +3        QUIT 

HD        ;

 +1        WRITE @IOF,!,$EXTRACT(ZLINE1,1,80),!?5,"Enter one at a time, as many fields as you wish to print. Fields will",!?5,"print in the order entered.",!,$EXTRACT(ZLINE1,1,80),!

 +2        QUIT 

INIT      ;

 +1        SET (CNT,LEV)=1

           SET FILE(LEV)=ZNUM

           KILL ^UTILITY($JOB,"INDIV")

 +2        SET DIC(0)="QEAM"

           SET DIC("W")="I $P(^DD(FILE(LEV),Y,0),U,2)>0 W ""    -->Mult Fld"""

 +3        QUIT