77 lines
4.0 KiB
Mathematica
77 lines
4.0 KiB
Mathematica
|
PXBIBB ;ALB/DWS/BDB - SEND CHARGE OR CREDIT TRANSACTIONS TO IBB ;8/10/05 1:29pm
|
||
|
|
;;1.0;PCE PATIENT CARE ENCOUNTER;**164**;Aug 12, 1996
|
||
|
|
N VSTB,PKB,VSTA,PKA,PRVB,PRVA,SC,IBBAPLR,IBBDFN
|
||
|
|
N IBBARFN,IBBUCID,CD,CD12,CDA,CDB,CDI,DX,IO,MOD
|
||
|
|
N IBBCTYPE,IBBORIEN,ND,TYPE,VDT,PPRV,SPRV,APRV,OPRV,ORY
|
||
|
|
S VSTA=$G(^TMP("PXKCO",$J,PXKVVST,"VST",PXKVVST,0,"AFTER"))
|
||
|
|
S PKA=$G(^TMP("PXKCO",$J,PXKVVST,"VST",PXKVVST,812,"AFTER"))
|
||
|
|
S IO=$P($G(^TMP("PXKCO",$J,PXKVVST,"VST",PXKVVST,150,"AFTER")),U,2)
|
||
|
|
S VSTB=$G(^TMP("PXKCO",$J,PXKVVST,"VST",PXKVVST,0,"BEFORE"))
|
||
|
|
S PKB=$G(^TMP("PXKCO",$J,PXKVVST,"VST",PXKVVST,812,"BEFORE"))
|
||
|
|
S:IO="" IO=$P($G(^TMP("PXKCO",$J,PXKVVST,"VST",PXKVVST,150,"BEFORE")),U,2)
|
||
|
|
Q:$P(VSTB,U,7)="E" Q:$P(VSTA,U,7)="E"
|
||
|
|
Q:$P(PKB,U,2)=$$PKG2IEN^VSIT("RMPR") Q:$P(PKA,U,2)=$$PKG2IEN^VSIT("RMPR")
|
||
|
|
S SC=$O(^SCE("AVSIT",PXKVVST,0))
|
||
|
|
S:'SC SC=$O(^TMP("PXKCO",$J,PXKVVST,"OE",0)) D:'SC Q:'SC
|
||
|
|
.Q:'IO
|
||
|
|
.S CDI=0 F S CDI=$O(^TMP("PXKCO",$J,PXKVVST,"CPT",CDI)) Q:CDI="" D
|
||
|
|
..S CDB=$G(^TMP("PXKCO",$J,PXKVVST,"CPT",CDI,0,"BEFORE"))
|
||
|
|
..I $P(CDB,U)'="" S CD=CDB,CD12=$G(^TMP("PXKCO",$J,PXKVVST,"CPT",CDI,12,"BEFORE")) D CHG("BEFORE")
|
||
|
|
..S CDA=$G(^TMP("PXKCO",$J,PXKVVST,"CPT",CDI,0,"AFTER"))
|
||
|
|
..I $P(CDA,U)'="" S CD=CDA,CD12=$G(^TMP("PXKCO",$J,PXKVVST,"CPT",CDI,12,"AFTER")) D CHG("AFTER")
|
||
|
|
S BSTATUS=$P($G(^TMP("PXKCO",$J,PXKVVST,"OE",SC,0,"BEFORE")),U,7)
|
||
|
|
I '$P($G(^SCE(SC,0)),U,7) Q:'BSTATUS D Q
|
||
|
|
.S CDI=0 F S CDI=$O(^TMP("PXKCO",$J,PXKVVST,"CPT",CDI)) Q:CDI="" D
|
||
|
|
..S CD=$G(^TMP("PXKCO",$J,PXKVVST,"CPT",CDI,0,"BEFORE"))
|
||
|
|
..S CD12=$G(^TMP("PXKCO",$J,PXKVVST,"CPT",CDI,12,"BEFORE"))
|
||
|
|
..D CHG("BEFORE")
|
||
|
|
S CDI=0 F S CDI=$O(^TMP("PXKCO",$J,PXKVVST,"CPT",CDI)) Q:CDI="" D
|
||
|
|
.S:BSTATUS CDB=$G(^TMP("PXKCO",$J,PXKVVST,"CPT",CDI,0,"BEFORE"))
|
||
|
|
.S CDA=$G(^TMP("PXKCO",$J,PXKVVST,"CPT",CDI,0,"AFTER"))
|
||
|
|
.I BSTATUS,$P(CDA,U)="" D D CHG("BEFORE") Q
|
||
|
|
..S CD=CDB,CD12=$G(^TMP("PXKCO",$J,PXKVVST,"CPT",CDI,12,"BEFORE"))
|
||
|
|
.S CD=CDA,CD12=$G(^TMP("PXKCO",$J,PXKVVST,"CPT",CDI,12,"AFTER"))
|
||
|
|
.D CHG("AFTER")
|
||
|
|
Q
|
||
|
|
CHG(TYPE) ;PROCESS DEBITS OR CREDITS, BEFORE = CREDIT, AFTER = DEBIT
|
||
|
|
N IBBFT1,IBBPR1,IBBDG1,IBBZCL,DXS,FDX,I
|
||
|
|
D LD($S(VSTA:VSTA,1:VSTB))
|
||
|
|
S IBBUCID=$P(CD,U,20),IBBORIEN=$P(CD,U,17),IBBFT1(2)="PX"_PXKVVST,IBBFT1(20)=$P(CD12,U,4),IBBFT1(21)=$P(CD12,U,2) ;PRFM,ORDR - CPT ENC,ORD
|
||
|
|
I 'IBBUCID S IBBUCID=$$GETCHGID^IBBAPI(),DA=CDI,DR=".2///"_IBBUCID D
|
||
|
|
.S DIE="^AUPNVCPT(" D ^DIE
|
||
|
|
S I="" F S I=$O(^TMP("PXKCO",$J,PXKVVST,"PRV",I)) Q:I="" D
|
||
|
|
.S PRV=$G(^TMP("PXKCO",$J,PXKVVST,"PRV",I,0,TYPE))
|
||
|
|
.I $P(PRV,U,4)="P" S PPRV=+PRV
|
||
|
|
.I $P(PRV,U,4)="S" S SPRV=+PRV
|
||
|
|
.I $P(PRV,U,5)="A" S APRV=+PRV
|
||
|
|
.I $P(PRV,U,5)="O" S OPRV=+PRV
|
||
|
|
I IBBFT1(20)="" S IBBFT1(20)=$G(PPRV) ;PRFM - NULL, THEN PRV PRIMARY
|
||
|
|
S IBBCTYPE=$S(TYPE="BEFORE":"CD",1:"CG"),IBBFT1(10)=$P(CD,U,16)
|
||
|
|
S (IBBFT1(13),I)=$S($P(CD,U,19)]"":$P(CD,U,19),1:999),IBBFT1(4)=$S(CD12:+CD12,1:VDT)
|
||
|
|
S IBBPR1(3)=+CD,IBBPR1(5)=IBBFT1(4)
|
||
|
|
I "180^401^402^403^404^406^407^409^410^411^412^413^415^457"[I D
|
||
|
|
.S IBBPR1(11,1)=$G(OPRV) I IBBPR1(11,1)="" S IBBPR1(11,1)=IBBFT1(20)
|
||
|
|
.S IBBPR1(11,2)=$G(APRV)
|
||
|
|
N IBBARFNZ I $E($T(ORACTREF^ORWPFSS),9)="(",I=108,IBBORIEN D ORACTREF^ORWPFSS(.IBBARFNZ,.IBBORIEN) I IBBARFNZ]"" S IBBARFN=IBBARFNZ
|
||
|
|
S MOD="",I=0
|
||
|
|
F S I=$O(^TMP("PXKCO",$J,PXKVVST,"CPT",CDI,1,TYPE,I)) Q:I="" S MOD=$S(MOD="":I,1:MOD_";"_I)
|
||
|
|
S I=0 F S I=$O(^TMP("PXKCO",$J,PXKVVST,"POV",I)) Q:I="" D
|
||
|
|
.S DXS=$G(^(I,0,TYPE))
|
||
|
|
.S DXS(+DXS)=$G(^TMP("PXKCO",$J,PXKVVST,"POV",I,800,TYPE))
|
||
|
|
S IBBPR1(16)=MOD
|
||
|
|
F I=1:1:8 S SC(I)="" ;SHAD
|
||
|
|
S FDX=1 F I=5,9:1:15 S DX=$P(CD,U,I) I DX S J=$S(I=5:1,1:I-7) D S FDX=0
|
||
|
|
.S IBBDG1(J,3)=DX,IBBDG1(J,6)="F",DXS=$G(DXS(DX))
|
||
|
|
.F J=1:1:8 I 'SC(J) D ;SHAD
|
||
|
|
..I $P($G(DXS(DX)),U,J) S SC(J)=1 Q
|
||
|
|
..I $P($G(DXS(DX)),U,J)="" S SC(J)="" Q
|
||
|
|
..I $P($G(DXS(DX)),U,J)=0,FDX=1 S SC(J)=0
|
||
|
|
S SC=$G(^TMP("PXKCO",$J,PXKVVST,"VST",PXKVVST,800,TYPE))
|
||
|
|
F I=1:1:8 I SC(I)="" S SC(I)=$P(SC,U,I) ;SHAD
|
||
|
|
F I=1:1:8 S J=$S(I=1:3,I=2:1,I=3:2,1:I),IBBZCL(J,2)=J,IBBZCL(J,3)=SC(I) ;SHAD
|
||
|
|
I IBBZCL(3,3) F I=1,2,4 S IBBZCL(I,3)=""
|
||
|
|
W $$CHARGE^IBBAPI(IBBDFN,IBBARFN,IBBCTYPE,IBBUCID,.IBBFT1,.IBBPR1,.IBBDG1,.IBBZCL,.IBBRXE,IBBORIEN,.IBBPROS)
|
||
|
|
Q
|
||
|
|
LD(ND) S IBBDFN=$P(ND,U,5),IBBARFN=$P(ND,U,26),VDT=+ND
|
||
|
|
Q
|