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