source: FOIAVistA/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/ECSUM2.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.0 KB
Line 
1ECSUM2 ;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
4START S ECPG=1,ECMORE=0 D HEADER I ECC="ALL" D CATS G END
5 I 'ECJLP S ECC=0,ECCN="None"
6CAT ;
7 W !!,?3,"Category: "_ECCN D:$Y+4>IOSL PAGE,HEADER:ECPG Q:ECOUT D PROC
8END S ECPG=1
9 Q
10SETC ;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
15HEADER ;
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
20CATS ;
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
24PROC ;
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
28SETP ;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
42PAGE ;
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
48MORE I ECMORE W !!,?3,"Category: "_ECCN
49 Q
Note: See TracBrowser for help on using the repository browser.