ECSUN1N.m

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

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

ALLU ;

 S ECD=0,ECPG=1 F  S ECD=$O(^ECK("APP",ECL,ECD)) Q:'ECD  D SET,HEADER,PROC D:'ECOUT PAGE G:ECOUT END

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 contine  " R X:DTIME

 K ECFLG

 S ECPG=0

 Q

HEADER ;

 S ECFLG=1

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

 Q

PROC ;

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

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

 .W !,?5,"Procedure:  "_ECPN,!,?5,"Event Code: ",ECL,"-",ECD,"-",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

 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

SET ;set var

 S ECNODE=$G(^ECD(+ECD,0))

 S ECDN=$S($P(ECNODE,"^")]"":$P(^(0),"^"),1:" ZZ #"_ECD_" MISSING DATA")

 S ECS=+$P(ECNODE,"^",2),ECSN=$S($P($G(^DIC(49,ECS,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN")

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ECSUN1N   1310     printed  Apr 09, 2024@21:01:13                                                                                                                                                                                                     Page 2

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

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

ALLU      ;

 +1        SET ECD=0

           SET ECPG=1

           FOR 

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

               if 'ECD

                   QUIT 

               DO SET

               DO HEADER

               DO PROC

               if 'ECOUT

                   DO PAGE

               if ECOUT

                   GOTO END

END        IF '$DATA(ECFLG)

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

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

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

                   READ X:DTIME

 +1        KILL ECFLG

 +2        SET ECPG=0

 +3        QUIT 

HEADER    ;

 +1        SET ECFLG=1

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

           FOR I=1:1:80

               WRITE "-"

 +3        QUIT 

PROC      ;

 +1        SET ECP=0

           FOR 

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

               if 'ECP!(ECOUT)

                   QUIT 

               Begin DoDot:1

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

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

 +4                if $Y+3>IOSL

                       DO PAGE

                       if ECPG

                           DO HEADER

                   if ECOUT

                       QUIT 

               End DoDot:1

               if ECOUT

                   QUIT 

 +5        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 

SET       ;set var

 +1        SET ECNODE=$GET(^ECD(+ECD,0))

 +2        SET ECDN=$SELECT($PIECE(ECNODE,"^")]"":$PIECE(^(0),"^"),1:" ZZ #"_ECD_" MISSING DATA")

 +3        SET ECS=+$PIECE(ECNODE,"^",2)

           SET ECSN=$SELECT($PIECE($GET(^DIC(49,ECS,0)),"^")]"":$PIECE(^(0),"^"),1:"UNKNOWN")

 +4        QUIT