source: FOIAVistA/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/ECSCPT1.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 2.5 KB
Line 
1ECSCPT1 ;ALB/JAM-Event Code Screens with CPT Codes;22 Jul 05
2 ;;2.0; EVENT CAPTURE ;**72**;8 May 96
3EN ;entry point
4 N UCNT,ECDO,ECCO,ECNT,ECINDT,ECP0
5 S (ECMORE,ECNT,ECDO,ECCO)=0,ECPG=1,ECCPT=$G(ECCPT,"B")
6 ;Process all DSS Units
7 I ECALL S ECD=0 D G END
8 .F S ECD=$O(^ECJ("AP",ECL,ECD)) Q:'ECD D Q:ECOUT
9 ..D SET,CATS,PAGE:'ECOUT&UCNT
10 ;Process a specific DSS Unit
11 S UCNT=0 D
12 .I ECC="ALL" D CATS Q
13 .I 'ECJLP S ECC=0,ECCN="None",ECCO=999
14 .D PROC
15END I 'ECNT W !!!,"Nothing Found."
16 S ECPG=1
17 Q
18SET ;set var
19 S ECDN=$S($P($G(^ECD(+ECD,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN"),UCNT=0
20 S ECDN=ECDN_$S($P($G(^ECD(+ECD,0)),"^",6):" **Inactive**",1:"")
21 Q
22SETC ;set cats
23 I ECC=0 S ECCN="None" Q
24 S ECCN=$S($P($G(^EC(726,+ECC,0)),"^")]"":$P(^(0),"^"),1:"ZZ #"_ECC_" MISSING DATA")
25 S ECMORE=1
26 Q
27HEADER ;
28 W:$E(IOST,1,2)="C-"!(ECPG>1) @IOF
29 W !!,?24,"EVENT CODE SCREENS WITH"
30 W $S(ECCPT="I":" INACTIVE",ECCPT="A":" ACTIVE",1:"")_" CPT CODES"
31 W ?70,"Page: ",ECPG,!?25,"Run Date: ",ECRDT,!?25,"LOCATION: "_ECLN
32 W !?25,"DSS UNIT: "_ECDN,! S ECPG=ECPG+1
33 F I=1:1:80 W "-"
34 Q
35CATS ;
36 S ECC="",ECCO=0
37 F S ECC=$O(^ECJ("AP",ECL,ECD,ECC)) Q:ECC="" D SETC,PROC Q:ECOUT
38 S ECMORE=0
39 Q
40PROC ;
41 S ECP=""
42 F S ECP=$O(^ECJ("AP",ECL,ECD,ECC,ECP)) Q:ECP="" D SETP Q:ECOUT
43 S ECMORE=0
44 Q
45SETP ;set procs
46 S ECPSY=+$O(^ECJ("AP",ECL,ECD,ECC,ECP,"")),ECPI=""
47 S ECPSYN=$P($G(^ECJ(ECPSY,"PRO")),"^",2),ECFILE=$P(ECP,";",2)
48 S ECFILE=$S($E(ECFILE)="I":81,$E(ECFILE)="E":725,1:"")
49 I ECFILE="" Q
50 S (ECPN,ECPT,NATN)="",ECPI=0
51 I ECFILE=81 S ECPI=$$CPT^ICPTCOD(+ECP) I +ECPI>0 D
52 .S ECPN=$P(ECPI,"^",3),ECPT=$P(ECPI,"^",2),ECINDT=$P(ECPI,"^",7)
53 I ECFILE=725 D
54 .S ECP0=$G(^EC(725,+ECP,0)),ECPT="",ECPN=$P(ECP0,"^")
55 .S NATN=$P(ECP0,"^",2)
56 .I $P(ECP0,"^",5)'="" S ECPI=$$CPT^ICPTCOD($P(ECP0,"^",5)) I +ECPI>0 D
57 ..S ECPT=$P(ECPI,"^",2),ECINDT=$P(ECPI,"^",7)
58 I +ECPI<1 Q
59 I ECCPT="A",'ECINDT Q
60 I ECCPT="I",ECINDT Q
61 I ECD'=ECDO D HEADER S ECDO=ECD
62 I ECC'=ECCO D S ECCO=ECC I ECOUT Q
63 .W !!,"Category: "_ECCN D:$Y+4>IOSL CONTD
64 S ECPN=$S(ECPSYN]"":ECPSYN,1:ECPN),ECNT=ECNT+1,UCNT=UCNT+1
65 W !,"Procedure: ",$E(ECPN,1,30)," (",$S(ECFILE=81:"CPT",1:"EC"),")",?48,"Nat'l #: ",NATN,?64,"CPT: ",ECPT
66 I ECCPT="B",'ECINDT W ?70," *I*"
67 D:($Y+3)>IOSL CONTD I ECOUT Q
68 Q
69CONTD ;Check whether to continue or exit
70 D PAGE I ECOUT Q
71 D HEADER:ECPG,MORE:$D(ECCN)
72 Q
73 ;
74PAGE ;
75 N SS,JJ
76 I $D(ECPG),$E(IOST,1,2)="C-" D
77 . S SS=22-$Y F JJ=1:1:SS W !
78 . S DIR(0)="E" W ! D ^DIR K DIR I 'Y S ECOUT=1
79 Q
80MORE I ECMORE W !!,"Category: "_ECCN
81 Q
Note: See TracBrowser for help on using the repository browser.