source: WorldVistAEHR/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/ECSUM1.m@ 1800

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

initial load of WorldVistAEHR

File size: 2.8 KB
RevLine 
[613]1ECSUM1 ;BIR/JLP,RHK-Category and Procedure Summary (cont'd) ;20 Mar 96
2 ;;2.0; EVENT CAPTURE ;**4,19,23,33,47**;8 May 96
3ALLU ;
4 N UCNT,ECDO,ECCO,ECNT
5 S (ECD,ECMORE,ECNT,ECDO,ECCO)=0,ECPG=1,ECSCN=$G(ECSCN,"B")
6 F S ECD=$O(^ECJ("AP",ECL,ECD)) Q:'ECD D Q:ECOUT
7 .D SET,CATS,PAGE:'ECOUT&UCNT
8END I 'ECNT W !!!,"Nothing Found."
9 S ECPG=1
10 Q
11SUM2 ;Prints Categories and Procedures for a DSS Unit
12 N UCNT,ECDO,ECCO,ECNT
13 S (ECDO,ECMORE,UCNT,ECNT,ECCO)=0,ECPG=1,ECSCN=$G(ECSCN,"B")
14 I ECC="ALL" D CATS G END
15 I 'ECJLP S ECC=0,ECCN="None",ECCO=999
16 D PROC
17 D END
18 Q
19SET ;set var
20 S ECDN=$S($P($G(^ECD(+ECD,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN"),UCNT=0
21 S ECDN=ECDN_$S($P($G(^ECD(+ECD,0)),"^",6):" **Inactive**",1:"")
22 S ECS=+$P($G(^ECD(+ECD,0)),"^",2)
23 S ECSN=$S($P($G(^DIC(49,ECS,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN")
24 Q
25SETC ;set cats
26 I ECC=0 S ECCN="None" Q
27 S ECCN=$S($P($G(^EC(726,+ECC,0)),"^")]"":$P(^(0),"^"),1:"ZZ #"_ECC_" MISSING DATA")
28 S ECMORE=1
29 Q
30HEADER ;
31 W:$E(IOST,1,2)="C-"!(ECPG>1) @IOF
32 W !!,?25,"CATEGORY AND PROCEDURE SUMMARY",?70,"Page: ",ECPG,!
33 W ?27,$S(ECSCN="I":"INACTIVE",ECSCN="A":"ACTIVE",1:" ALL")_" EVENT CODE"
34 W " SCREENS",!?25,"Run Date : ",ECRDT,!?25,"LOCATION: "_ECLN
35 W !,?25,"SERVICE: ",ECSN,!?25,"DSS UNIT: "_ECDN,! S ECPG=ECPG+1
36 F I=1:1:80 W "-"
37 Q
38CATS ;
39 S ECC="",ECCO=0
40 F S ECC=$O(^ECJ("AP",ECL,ECD,ECC)) Q:ECC="" D SETC,PROC Q:ECOUT
41 S ECMORE=0
42 Q
43PROC ;
44 S ECP=""
45 F S ECP=$O(^ECJ("AP",ECL,ECD,ECC,ECP)) Q:ECP="" D SETP Q:ECOUT
46 S ECMORE=0
47 Q
48SETP ;set procs
49 S ECPSY=+$O(^ECJ("AP",ECL,ECD,ECC,ECP,""))
50 S ECINDT=$P($G(^ECJ(ECPSY,0)),"^",2)
51 I ECSCN="A",ECINDT'="" Q
52 I ECSCN="I",ECINDT="" Q
53 I ECD'=ECDO D HEADER S ECDO=ECD
54 I ECC'=ECCO D S ECCO=ECC I ECOUT Q
55 .W !!,?3,"Category: "_ECCN D:$Y+4>IOSL PAGE,HEADER:ECPG,MORE:$D(ECCN)
56 S ECPSYN=$P($G(^ECJ(ECPSY,"PRO")),"^",2),EC4=+$P($G(^("PRO")),"^",4)
57 S EC2="" I EC4 S EC2=$S($P($G(^SC(EC4,0)),"^")]"":$P(^(0),"^"),1:"NO ASSOCIATED CLINIC")
58 S ECFILE=$P(ECP,";",2),ECFILE=$S($E(ECFILE)="I":81,$E(ECFILE)="E":725,1:"UNKNOWN")
59 I ECFILE="UNKNOWN" S ECPN="UNKNOWN",NATN="UNKNOWN"
60 I ECFILE=81 S ECPI=$$CPT^ICPTCOD(+ECP) D
61 .S ECPN=$S($P(ECPI,"^",3)]"":$P(ECPI,"^",3),1:"UNKNOWN"),NATN=$S($P(ECPI,"^",2)]"":$P(ECPI,"^",2),1:"NOT LISTED") K ECPI
62 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")
63 S ECPN=$S(ECPSYN]"":ECPSYN,1:ECPN),ECNT=ECNT+1,UCNT=UCNT+1
64 W !,?3,"Procedure: ",$E(ECPN,1,30)," (",$S(ECFILE=81:"CPT",1:"EC"),")",?52,"Nat'l No.: ",NATN
65 W:EC2]"" !,?14,"(Clinic: "_EC2_")"
66 I $P($G(^ECJ(+ECPSY,0)),"^",2),ECSCN="B" W ?70,"*INACTIVE*"
67 D:($Y+3)>IOSL PAGE,HEADER:ECPG,MORE:$D(ECCN) Q:ECOUT
68 Q
69PAGE ;
70 N SS,JJ
71 I $D(ECPG),$E(IOST,1,2)="C-" D
72 . S SS=22-$Y F JJ=1:1:SS W !
73 . S DIR(0)="E" W ! D ^DIR K DIR I 'Y S ECOUT=1
74 Q
75MORE I ECMORE W !!,?3,"Category: "_ECCN
76 Q
Note: See TracBrowser for help on using the repository browser.