| 1 | ECSCPT1 ;ALB/JAM-Event Code Screens with CPT Codes;22 Jul 05
|
|---|
| 2 | ;;2.0; EVENT CAPTURE ;**72**;8 May 96
|
|---|
| 3 | EN ;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
|
|---|
| 15 | END I 'ECNT W !!!,"Nothing Found."
|
|---|
| 16 | S ECPG=1
|
|---|
| 17 | Q
|
|---|
| 18 | SET ;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
|
|---|
| 22 | SETC ;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
|
|---|
| 27 | HEADER ;
|
|---|
| 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
|
|---|
| 35 | CATS ;
|
|---|
| 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
|
|---|
| 40 | PROC ;
|
|---|
| 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
|
|---|
| 45 | SETP ;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
|
|---|
| 69 | CONTD ;Check whether to continue or exit
|
|---|
| 70 | D PAGE I ECOUT Q
|
|---|
| 71 | D HEADER:ECPG,MORE:$D(ECCN)
|
|---|
| 72 | Q
|
|---|
| 73 | ;
|
|---|
| 74 | PAGE ;
|
|---|
| 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
|
|---|
| 80 | MORE I ECMORE W !!,"Category: "_ECCN
|
|---|
| 81 | Q
|
|---|
