- 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
- 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 ---[H[J[2J[HECSUN1N 1310 printed Feb 18, 2025@23:25:22 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
- +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
