| [613] | 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
|
|---|
