Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCERP6A

IBCERP6A.m

Go to the documentation of this file.
  1. IBCERP6A ;ALB/JEH - READY FOR EXTRACT LIST MANAGER REPORT ;27-OCT-99
  1. ;;2.0;INTEGRATED BILLING;**137**;21-MAR-94
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. EN ; - Ask device
  1. N %ZIS,ZTRTN,ZTSAVE,ZTDESC
  1. S %ZIS="QM" D ^%ZIS G:POP ENQ1
  1. I $D(IO("Q")) D G ENQ1
  1. .S ZTRTN="LIST^IBCERP6A",ZTDESC="IB - EDI/MRA Claims in Rescue Process"
  1. .S ZTSAVE("IBPARAM")="",ZTSAVE("^TMP(""IBCERP6"",$J,")=""
  1. .D ^%ZTLOAD
  1. .W !!,$S($D(ZTSK):"Your task number"_ZTSK_" has been queued.",1:"Unable to queue this job.")
  1. .K ZTSK,IO("Q") D HOME^%ZIS
  1. U IO
  1. ;
  1. LIST ; - Tasked entry point
  1. ;
  1. ;
  1. S (IBQUIT,IBPG)=0 D HDR
  1. I '$D(^TMP("IBCERP6",$J)) W !!,"There are no records to print" G ENQ1
  1. S IBSTAT="" F S IBSTAT=$O(^TMP("IBCERP6",$J,IBSTAT)) Q:IBSTAT=""!(IBQUIT) D
  1. .S IBILL="" F S IBILL=$O(^TMP("IBCERP6",$J,IBSTAT,IBILL)) Q:IBILL=""!(IBQUIT) S IBREC=^(IBILL) D
  1. ..I ($Y+5)>IOSL D I IBQUIT Q
  1. ...D ASK I IBQUIT Q
  1. ...D HDR
  1. ..;
  1. ..W !,?2,$P(IBREC,U,2),?15,$P(IBREC,U,3),?22,$P(IBREC,U,4)
  1. ..W ?28,$E($P(IBREC,U,5),1,4),?35,$P(IBREC,U,6),?40,$E($P(IBREC,U,7),6,7)_"/"_$E($P(IBREC,U,7),4,5)_"/"_$E($P(IBREC,U,7),2,3)
  1. ..W ?50,$P(IBREC,U,8),?55,$E($P(IBREC,U,9),1,13),?70,$E($P(IBREC,U,10),1,9)
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. ;
  1. I '$D(ZTQUEUED) D ^%ZISC
  1. ENQ1 K IBSTAT,IBILL,IBREC,IBPG,IBQUIT
  1. Q
  1. HDR ;Prints report heading
  1. I $E(IOST,1,2)="C-" W @IOF,*13
  1. S IBPG=IBPG+1
  1. W !!,?25,"Claims in Rescue Process",?55,$$FMTE^XLFDT(DT),?70,"Page: ",IBPG
  1. W !!,?15,"Inpt/",?22,"Inst/",!,?4,"Bill #",?15,"Opt",?22,"Prof",?28,"Name"
  1. W ?35,"SSN",?40,"Stmt Date",?50,"Type",?55,"Ins Co.",?70,"Status"
  1. W !,$TR($J("",IOM)," ","=")
  1. Q
  1. ;
  1. ASK ;
  1. I $E(IOST,1,2)'["C-" Q
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT
  1. S DIR(0)="E" D ^DIR
  1. I ($D(DIRUT))!($D(DUOUT)) S IBQUIT=1 Q
  1. Q
  1. ;