ECSUN2.m

ECSUN2 ;BIR/JLP,RHK-Category and Procedure Summary (cont'd) ;21 Mar 96

 ;;2.0; EVENT CAPTURE ;**23**;8 May 96

 ;Prints Categories and Procedures for a DSS Unit

 I ECJLP D ^ECSUN2N Q

START S ECPG=1,ECMORE=0 D HEADER I ECC="ALL" D CATS G END

CAT ;

 W !!,?3,"Category:  "_ECCN D:$Y+4>IOSL PAGE,HEADER:ECPG Q:ECOUT  D PROC

END I '$D(ECFLG) W !!,"No Category and Procedure Summary (Old File) data to report.",!

 I $E(IOST,1,2)="C-" W !!,"Press <RET> to continue  " R X:DTIME S ECPG=0

 K ECFLG

 Q

HEADER ;

 S ECFLG=1

 W:$Y @IOF W !!,?25,"CATEGORY AND PROCEDURE SUMMARY",!,?25,"Run Date:  ",ECDATE,!,?25,"LOCATION:  "_ECLN,!,?25,"SERVICE:   "_ECSN,!,?25,"DSS UNIT:  "_ECDN,! F I=1:1:80 W "-"

 I $D(ECCN) D MORE

 Q

CATS ;

 S ECC=0 F  S ECC=$O(^ECK("AP",ECL,ECD,ECC)) Q:'ECC  S ECCN=$S($P($G(^ECP(+ECC,0)),"^")]"":$P(^(0),"^"),1:" ZZ #"_+ECC_" MISSING DATA"),ECMORE=1 W !!,?3,"Category:  "_ECCN D:$Y+4>IOSL PAGE,HEADER:ECPG Q:ECOUT  D PROC

 S ECMORE=0 Q

PROC ;

 S ECP=0 F  S ECP=$O(^ECK("AP",ECL,ECD,ECC,ECP)) Q:'ECP  D  Q:ECOUT

 .S ECPN=$S($P($G(^ECP(+ECP,0)),"^")]"":$P(^(0),"^"),1:" ZZ #"_+ECP_" MISSING DATA")

 .S ECMORE=1

 .W !,?5,"Procedure:  ",ECPN,!,?5,"Event Code: ",ECL,"-",ECD,"-",ECC,"-",ECP,!,?5,"National Number:   ",$S($P($G(^ECP(+ECP,0)),"^",2)]"":$P(^(0),"^",2),1:"NOT DEFINED"),!

 .D:$Y+3>IOSL PAGE,HEADER:ECPG Q:ECOUT

 S ECMORE=0 Q

PAGE ;

 I $D(ECPG),$E(IOST,1,2)="C-" W !!,"Press <RET> to continue, or ^ to quit " R X:DTIME I '$T!(X="^") S ECOUT=1,ECPG=0 Q

 Q

MORE I ECMORE W !!,?3,"Category:  "_ECCN

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ECSUN2   1546     printed  Mar 13, 2025@21:03:49                                                                                                                                                                                                      Page 2

ECSUN2    ;BIR/JLP,RHK-Category and Procedure Summary (cont'd) ;21 Mar 96

 +1       ;;2.0; EVENT CAPTURE ;**23**;8 May 96

 +2       ;Prints Categories and Procedures for a DSS Unit

 +3        IF ECJLP

               DO ^ECSUN2N

               QUIT 

START      SET ECPG=1

           SET ECMORE=0

           DO HEADER

           IF ECC="ALL"

               DO CATS

               GOTO END

CAT       ;

 +1        WRITE !!,?3,"Category:  "_ECCN

           if $Y+4>IOSL

               DO PAGE

               if ECPG

                   DO HEADER

           if ECOUT

               QUIT 

           DO PROC

END        IF '$DATA(ECFLG)

               WRITE !!,"No Category and Procedure Summary (Old File) data to report.",!

 +1        IF $EXTRACT(IOST,1,2)="C-"

               WRITE !!,"Press <RET> to continue  "

               READ X:DTIME

               SET ECPG=0

 +2        KILL ECFLG

 +3        QUIT 

HEADER    ;

 +1        SET ECFLG=1

 +2        if $Y

               WRITE @IOF

           WRITE !!,?25,"CATEGORY AND PROCEDURE SUMMARY",!,?25,"Run Date:  ",ECDATE,!,?25,"LOCATION:  "_ECLN,!,?25,"SERVICE:   "_ECSN,!,?25,"DSS UNIT:  "_ECDN,!

           FOR I=1:1:80

               WRITE "-"

 +3        IF $DATA(ECCN)

               DO MORE

 +4        QUIT 

CATS      ;

 +1        SET ECC=0

           FOR 

               SET ECC=$ORDER(^ECK("AP",ECL,ECD,ECC))

               if 'ECC

                   QUIT 

               SET ECCN=$SELECT($PIECE($GET(^ECP(+ECC,0)),"^")]"":$PIECE(^(0),"^"),1:" ZZ #"_+ECC_" MISSING DATA")

               SET ECMORE=1

               WRITE !!,?3,"Category:  "_ECCN

               if $Y+4>IOSL

                   DO PAGE

                   if ECPG

                       DO HEADER

               if ECOUT

                   QUIT 

               DO PROC

 +2        SET ECMORE=0

           QUIT 

PROC      ;

 +1        SET ECP=0

           FOR 

               SET ECP=$ORDER(^ECK("AP",ECL,ECD,ECC,ECP))

               if 'ECP

                   QUIT 

               Begin DoDot:1

 +2                SET ECPN=$SELECT($PIECE($GET(^ECP(+ECP,0)),"^")]"":$PIECE(^(0),"^"),1:" ZZ #"_+ECP_" MISSING DATA")

 +3                SET ECMORE=1

 +4                WRITE !,?5,"Procedure:  ",ECPN,!,?5,"Event Code: ",ECL,"-",ECD,"-",ECC,"-",ECP,!,?5,"National Number:   ",$SELECT($PIECE($GET(^ECP(+ECP,0)),"^",2)]"":$PIECE(^(0),"^",2),1:"NOT DEFINED"),!

 +5                if $Y+3>IOSL

                       DO PAGE

                       if ECPG

                           DO HEADER

                   if ECOUT

                       QUIT 

               End DoDot:1

               if ECOUT

                   QUIT 

 +6        SET ECMORE=0

           QUIT 

PAGE      ;

 +1        IF $DATA(ECPG)

               IF $EXTRACT(IOST,1,2)="C-"

                   WRITE !!,"Press <RET> to continue, or ^ to quit "

                   READ X:DTIME

                   IF '$TEST!(X="^")

                       SET ECOUT=1

                       SET ECPG=0

                       QUIT 

 +2        QUIT 

MORE       IF ECMORE

               WRITE !!,?3,"Category:  "_ECCN

 +1        QUIT