Changeset 636 for FOIAVistA/tag/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCECSA3.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCECSA3.m (modified) (4 diffs)

FOIAVistA/tag/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCECSA3.m

@@ -1 +1 @@
 IBCECSA3 ;ALB/CXW - CLAIMS STATUS AWAITING RESOLUTION REPORT ;23-JUL-99
- ;;2.0;INTEGRATED BILLING;**137,320,371,377**;21-MAR-94;Build 23
- ;;Per VHA Directive 2004-038, this routine should not be modified.
+ ;;2.0;INTEGRATED BILLING;**137,320**;21-MAR-94
  Q
 EN ; Report of claims status awaiting resolution
- NEW %ZIS,ZTSAVE,ZTRTN,ZTDESC,DIR,X,Y,DIRUT,DTOUT,DUOUT,DIROUT,IBRVW
- ;
  D FULL^VALM1
- W !
- S DIR(0)="YO"           ; IB*2*377 new question
- S DIR("A")="Would you like to include Review Comments with this report"
- S DIR("B")="No"
- D ^DIR K DIR
- I $D(DIRUT) Q
- S IBRVW=Y
- ;
  W !!,"You will need a 132 column printer for this report!",!
  ;
+ N %ZIS,ZTSAVE,ZTRTN,ZTDESC
  S %ZIS="QM" D ^%ZIS Q:POP
  I $D(IO("Q")) K IO("Q") D  Q
@@ -25 +15 @@
  . S ZTSAVE("IBSORTOR")=""
  . S ZTSAVE("^TMP(""IBCECSB"",$J,")=""
- . S ZTSAVE("IBRVW")=""
  . S ZTDESC="IB -Claims Status Awaiting Resolution Report" D ^%ZTLOAD K ZTSK D HOME^%ZIS
  U IO
@@ -35 +24 @@
  I '$D(^TMP("IBCECSB",$J)) D  G LISTQ
  . D HDR1 W !,"No entries found for this report"
- S IBX="" F  S IBX=$O(^TMP("IBCECSB",$J,IBX)) Q:IBX=""!IBSTOP  S IBX2="" F  S IBX2=$O(^TMP("IBCECSB",$J,IBX,IBX2)) Q:IBX2=""!IBSTOP  S IBX3="" F  S IBX3=$O(^TMP("IBCECSB",$J,IBX,IBX2,IBX3)) Q:IBX3=""!IBSTOP  D  Q:IBSTOP
+ S IBX="" F  S IBX=$O(^TMP("IBCECSB",$J,IBX)) Q:IBX=""!IBSTOP  S IBX2="" F  S IBX2=$O(^TMP("IBCECSB",$J,IBX,IBX2)) Q:IBX2=""!IBSTOP  S IBX3="" F  S IBX3=$O(^TMP("IBCECSB",$J,IBX,IBX2,IBX3)) Q:IBX3=""!IBSTOP  D
  . I 'IBFST S IBPAY=$$IBPAY(IBX,IBX2,IBX3) D HDR1 S:'IBDIV IBFST=1 Q:IBSTOP
- . S IBDA=0 F  S IBDA=$O(^TMP("IBCECSB",$J,IBX,IBX2,IBX3,IBDA)) Q:'IBDA!IBSTOP  S IB=$G(^TMP("IBCECSB",$J,IBX,IBX2,IBX3,IBDA)) D  Q:IBSTOP
- .. I ($Y+3)>IOSL D HDR1 Q:IBSTOP
- .. W $$BN1^PRCAFN(+IB),$P(IB,U,12),?13,$E($P(IB,U,2),1,25),?40,$E($P(IB,U,3),1,30),?72,$P($P(IB,U,4),"~"),?78,$$DAT1^IBOUTL($P(IB,U,5)),?88,$E($P(IB,U,7),1,10),?100,"$"_$J($P(IB,U,6),0,2),?110,$P(IB,U,10),?122,$P(IB,U,11),!
- .. I $P(IB,U,12)="*" W " ***** CSA REVIEW IN PROCESS *****",!
+ . S IBDA=0 F  S IBDA=$O(^TMP("IBCECSB",$J,IBX,IBX2,IBX3,IBDA)) Q:'IBDA!IBSTOP  S IB=$G(^TMP("IBCECSB",$J,IBX,IBX2,IBX3,IBDA)) D
+ .. I ($Y+5)>IOSL D HDR1 Q:IBSTOP
+ .. W $$BN1^PRCAFN(+IB),?13,$E($P(IB,U,2),1,25),?40,$E($P(IB,U,3),1,30),?72,$P($P(IB,U,4),"~"),?78,$$DAT1^IBOUTL($P(IB,U,5)),?88,$E($P(IB,U,7),1,10),?100,"$"_$J($P(IB,U,6),0,2),?110,$P(IB,U,10),?122,$P(IB,U,11),!
  .. W " FORM TYPE: "_$P($G(^IBE(353,$P($G(^DGCR(399,+IB,0)),U,19),0)),U),!
  .. I 'IBDIV S X=" DIVISION: "_$P(IB,U,8) W X,$J(" ",40-$L(X))_"AUTHORIZING BILLER: "_$P($P(IB,U,9),"~",1),!
@@ -48 +36 @@
  ... F I=1:131:$L(X) W " "_$E(X,I,I+130),!
  ... S IBZFT=1
- ... I ($Y+3)>IOSL D HDR1 Q:IBSTOP
- ... Q
- .. Q:IBSTOP
- .. ;
- .. ; Display the Review Comments if they exist based on user choice (IB*377)
- .. I $G(IBRVW),+$O(^IBM(361,IBDA,2,0)) D  Q:IBSTOP
- ... N IBCM,IBT1,IBT0,IBD0,IBCL
- ... I ($Y+3)>IOSL D HDR1 Q:IBSTOP
- ... W ?3,"*** Review Comments for Claim "_$$BN1^PRCAFN(+IB)_" ***",!
- ... S IBCM=0 F IBT1=0:1 S IBCM=$O(^IBM(361,IBDA,2,IBCM)) Q:'IBCM     ; count up # of comments
- ... S IBT0=0
- ... S IBCM=0 F  S IBCM=$O(^IBM(361,IBDA,2,IBCM)) Q:'IBCM!IBSTOP  D  Q:IBSTOP
- .... S IBT0=IBT0+1
- .... S IBD0=$G(^IBM(361,IBDA,2,IBCM,0))
- .... I ($Y+3)>IOSL D HDR1 Q:IBSTOP
- .... W ?7,"Entered "_$$FMTE^XLFDT($P(IBD0,U,1),"5ZPM")
- .... I $P(IBD0,U,2) W " by "_$P($G(^VA(200,$P(IBD0,U,2),0)),U,1)
- .... W " ("_IBT0_" of "_IBT1_")",!
- .... S IBCL=0 F  S IBCL=$O(^IBM(361,IBDA,2,IBCM,1,IBCL)) Q:'IBCL!IBSTOP  D  Q:IBSTOP
- ..... I ($Y+3)>IOSL D HDR1 Q:IBSTOP
- ..... W ?10,$G(^IBM(361,IBDA,2,IBCM,1,IBCL,0)),!
- ..... Q
- .... Q
- ... Q
- .. ;
- .. ; Display a line break before the next claim in this report
- .. I ($Y+3)>IOSL D HDR1 Q:IBSTOP
+ ... I ($Y+5)>IOSL D HDR1 Q:IBSTOP
  .. W !
- .. Q
- . Q
- ;
  G:IBSTOP LISTQ
  I $E(IOST,1,2)["C-" K DIR S DIR(0)="E" D ^DIR K DIR