1 | ECSUM2 ;BIR/JLP,RHK-Category and Procedure Summary (cont'd) ;20 Mar 96
|
---|
2 | ;;2.0; EVENT CAPTURE ;**4,19,23**;8 May 96
|
---|
3 | ;Prints Categories and Procedures for a DSS Unit
|
---|
4 | START S ECPG=1,ECMORE=0 D HEADER I ECC="ALL" D CATS G END
|
---|
5 | I 'ECJLP S ECC=0,ECCN="None"
|
---|
6 | CAT ;
|
---|
7 | W !!,?3,"Category: "_ECCN D:$Y+4>IOSL PAGE,HEADER:ECPG Q:ECOUT D PROC
|
---|
8 | END S ECPG=1
|
---|
9 | Q
|
---|
10 | SETC ;set cats
|
---|
11 | I ECC=0 S ECCN="None" Q
|
---|
12 | S ECCN=$S($P($G(^EC(726,+ECC,0)),"^")]"":$P(^(0),"^"),1:"ZZ #"_ECC_" MISSING DATA")
|
---|
13 | S ECMORE=1
|
---|
14 | Q
|
---|
15 | HEADER ;
|
---|
16 | W:$E(IOST,1,2)="C-"!(ECPG>1) @IOF S ECPG=ECPG+1
|
---|
17 | W !!,?25,"CATEGORY AND PROCEDURE SUMMARY",!,?25,"Run Date : ",ECRDT W !,?25,"LOCATION: "_ECLN,!,?25,"SERVICE: "_ECSN,!,?25,"DSS UNIT: "_ECDN,! F I=1:1:80 W "-"
|
---|
18 | I $D(ECCN) D MORE
|
---|
19 | Q
|
---|
20 | CATS ;
|
---|
21 | S ECC="" F S ECC=$O(^ECJ("AP",ECL,ECD,ECC)) Q:ECC="" D SETC W !!,?3,"Category: "_ECCN D:$Y+4>IOSL PAGE,HEADER:ECPG Q:ECOUT D PROC
|
---|
22 | S ECMORE=0
|
---|
23 | Q
|
---|
24 | PROC ;
|
---|
25 | S ECP="" F S ECP=$O(^ECJ("AP",ECL,ECD,ECC,ECP)) Q:ECP="" D SETP Q:ECOUT
|
---|
26 | S ECMORE=0
|
---|
27 | Q
|
---|
28 | SETP ;set procs
|
---|
29 | S ECPSY=+$O(^ECJ("AP",ECL,ECD,ECC,ECP,""))
|
---|
30 | S ECPSYN=$P($G(^ECJ(ECPSY,"PRO")),"^",2),EC4=+$P($G(^("PRO")),"^",4)
|
---|
31 | S EC2="" I EC4 S EC2=$S($P($G(^SC(EC4,0)),"^")]"":$P(^(0),"^"),1:"NO ASSOCIATED CLINIC")
|
---|
32 | S ECFILE=$P(ECP,";",2),ECFILE=$S($E(ECFILE)="I":81,$E(ECFILE)="E":725,1:"UNKNOWN")
|
---|
33 | I ECFILE="UNKNOWN" S ECPN="UNKNOWN",NATN="UNKNOWN"
|
---|
34 | I ECFILE=81 S ECPN=$S($P($G(^ICPT(+ECP,0)),"^",2)]"":$P(^(0),"^",2),1:"UNKNOWN"),NATN=$S($P($G(^ICPT(+ECP,0)),"^")]"":$P(^(0),"^"),1:"NOT LISTED")
|
---|
35 | I ECFILE=725 S ECPN=$S($P($G(^EC(725,+ECP,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN"),NATN=$S($P($G(^EC(725,+ECP,0)),"^",2)]"":$P(^(0),"^",2),1:"NOT LISTED")
|
---|
36 | S ECPN=$S(ECPSYN]"":ECPSYN,1:ECPN)
|
---|
37 | W !,?3,"Procedure: ",$E(ECPN,1,30)," (",$S(ECFILE=81:"CPT",1:"EC"),")",?52,"Nat'l No.: ",NATN
|
---|
38 | W:EC2]"" !,?14,"(Clinic: "_EC2_")"
|
---|
39 | I $P($G(^ECJ(+ECPSY,0)),"^",2) W ?70,"*INACTIVE*"
|
---|
40 | D:$Y+3>IOSL PAGE,HEADER:ECPG Q:ECOUT
|
---|
41 | Q
|
---|
42 | PAGE ;
|
---|
43 | N SS,JJ
|
---|
44 | I $D(ECPG),$E(IOST,1,2)="C-" D
|
---|
45 | . S SS=22-$Y F JJ=1:1:SS W !
|
---|
46 | . S DIR(0)="E" W ! D ^DIR K DIR I 'Y S ECOUT=1
|
---|
47 | Q
|
---|
48 | MORE I ECMORE W !!,?3,"Category: "_ECCN
|
---|
49 | Q
|
---|