| 1 | ECBENF ;BIR/MAM,JPW-Stuff New Batched Procedures ;12 Feb 96
|
|---|
| 2 | ;;2.0; EVENT CAPTURE ;**4,5,13,17,18,23,42,54,72**;8 May 96
|
|---|
| 3 | CRAM ; entry
|
|---|
| 4 | S ECDT=$P(ECA,"^"),ECL=$P(ECA,"^",2),ECS=$P(ECA,"^",3),ECM=$P(ECA,"^",4),ECD=$P(ECA,"^",5)
|
|---|
| 5 | S ECPCE=$P(ECA,"^",6)
|
|---|
| 6 | S (CNT,CNT1)=0
|
|---|
| 7 | F S CNT1=$O(ECPT(CNT1)) Q:'CNT1 D
|
|---|
| 8 | .S ECNODE2=$G(ECPT(CNT1))
|
|---|
| 9 | .S ECELIG=$G(ECELPT(CNT1))
|
|---|
| 10 | .S ECPS=$P(ECNODE2,"^"),ECDX=$P(ECNODE2,"^",3),ECINP=$P(ECNODE2,"^",4),ECVST=$P(ECNODE2,"^",5),ECSC=$P(ECNODE2,"^",6),ECAO=$P(ECNODE2,"^",7),ECIR=$P(ECNODE2,"^",8),ECZEC=$P(ECNODE2,"^",9),ECMST=$P(ECNODE2,"^",12)
|
|---|
| 11 | .S ECHNC=$P(ECNODE2,"^",13),ECCV=$P(ECNODE2,"^",14)
|
|---|
| 12 | .F S CNT=$O(ECEC(CNT)) Q:'CNT D
|
|---|
| 13 | ..S EC4=$P(ECNODE2,"^",10),ECID=$P(ECNODE2,"^",11)
|
|---|
| 14 | ..D NODE D DIE
|
|---|
| 15 | END D ^ECKILL K DLAYGO S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 16 | Q
|
|---|
| 17 | NODE ;set patient array data
|
|---|
| 18 | S ECNODE=ECEC(CNT)
|
|---|
| 19 | S ECC=+$P(ECNODE,"^"),ECP=$P(ECNODE,"^",2),ECO=$P(ECNODE,"^",4),ECV=$P(ECNODE,"^",5)
|
|---|
| 20 | S ECCPT=$P(ECNODE,"^",11),ECPRPTR=$P(ECNODE,"^",12)
|
|---|
| 21 | ;
|
|---|
| 22 | ;- Get associated clinic from event code screen if null
|
|---|
| 23 | S:$G(EC4)="" EC4=$P($G(^ECJ(+$O(^ECJ("AP",+ECL,+ECD,+ECC,$G(ECP),0)),"PRO")),"^",4)
|
|---|
| 24 | S:$G(ECID)="" ECID=$P($G(^SC(+EC4,0)),"^",7)
|
|---|
| 25 | Q
|
|---|
| 26 | DIE ;
|
|---|
| 27 | L +^ECH(0) S ECRN=$P(^ECH(0),"^",3)+1 I $D(^ECH(ECRN)) S $P(^ECH(0),"^",3)=$P(^ECH(0),"^",3)+1 L -^ECH(0) G DIE
|
|---|
| 28 | L -^ECH(0) K DD,DO,DIC S X=ECRN,DIC(0)="L",DLAYGO=721,DIC="^ECH(" D FILE^DICN K DIC S ECFN=+Y
|
|---|
| 29 | ; set the zero node
|
|---|
| 30 | S ^ECH(ECFN,0)=ECFN_"^"_ECPS_"^"_ECDT_"^"_ECL_"^"_ECS_"^"_ECM_"^"_ECD_"^"_ECC_"^"_ECP_"^"_ECV_"^^"_ECO_"^"_ECDUZ_"^^^^^^"_EC4_"^"_ECID_"^"_ECVST_"^"_ECINP
|
|---|
| 31 | ;ALB/JAM file multiple providers (EC*2*72)
|
|---|
| 32 | S ECFIL=$$FILPRV^ECPRVMUT(ECFN,.ECPRVARY,.ECOUT) K ECFIL
|
|---|
| 33 | ; ALB/JAM add CPT procedure modifiers
|
|---|
| 34 | I $O(ECEC(CNT,"MOD",""))'="" D K MODIEN,MOD
|
|---|
| 35 | . S MOD="" F S MOD=$O(ECEC(CNT,"MOD",MOD)) Q:MOD="" D
|
|---|
| 36 | . . S MODIEN=$P(ECEC(CNT,"MOD",MOD),U,2) I MODIEN<0 Q
|
|---|
| 37 | . . K DIC,DD,DO
|
|---|
| 38 | . . S DIC(0)="L",DA(1)=ECFN,DIC="^ECH("_DA(1)_","_"""MOD"""_","
|
|---|
| 39 | . . S DIC("P")=$P(^DD(721,36,0),U,2),X=MODIEN
|
|---|
| 40 | . . D FILE^DICN
|
|---|
| 41 | ; ALB/ESD - Set procedure reason into zero node
|
|---|
| 42 | I +ECPRPTR S $P(^ECH(ECFN,0),"^",23)=+ECPRPTR
|
|---|
| 43 | ;set the "P" node
|
|---|
| 44 | S ^ECH(ECFN,"P")=ECCPT_"^"_ECDX_"^"_ECAO_"^"_ECIR_"^"_ECZEC_"^"_ECSC
|
|---|
| 45 | S $P(^ECH(ECFN,"P"),"^",9,12)=ECMST_"^"_ECHNC_"^"_ECCV
|
|---|
| 46 | ; ALB/JAM - add secondary diagnosis codes
|
|---|
| 47 | I $O(ECPT(CNT1,"DXS",""))'="" D K DXSIEN,DXS
|
|---|
| 48 | . S DXS="" F S DXS=$O(ECPT(CNT1,"DXS",DXS)) Q:DXS="" D
|
|---|
| 49 | . . S DXSIEN=$P(ECPT(CNT1,"DXS",DXS),U) I DXSIEN<0 Q
|
|---|
| 50 | . . K DIC,DD,DO
|
|---|
| 51 | . . S DIC(0)="L",DA(1)=ECFN,DIC="^ECH("_DA(1)_","_"""DX"""_","
|
|---|
| 52 | . . S DIC("P")=$P(^DD(721,38,0),U,2),X=DXSIEN
|
|---|
| 53 | . . D FILE^DICN
|
|---|
| 54 | K ECDXX M ECDXX=ECPT(CNT1,"DXS")
|
|---|
| 55 | S PXUPD=$$PXUPD^ECUTL2(ECPS,ECDT,ECL,EC4,ECDX,.ECDXX,ECFN) K PXUPD,ECDXX
|
|---|
| 56 | XREF ; sets crossreferences
|
|---|
| 57 | S DIK="^ECH(",DA=ECFN D IX1^DIK K DA,DIK
|
|---|
| 58 | ;
|
|---|
| 59 | PCE ;format PCE data to send
|
|---|
| 60 | Q:$P(ECPCE,"~",2)="N" I $P(ECPCE,"~",2)="O"&(ECINP'="O") Q
|
|---|
| 61 | D PCE^ECBEN2U
|
|---|
| 62 | Q
|
|---|
