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