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
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 ---[H[J[2J[HECSUN2 1546 printed Dec 13, 2024@01:58:59 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
+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
