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

IBJDF8R.m

Go to the documentation of this file.
  1. IBJDF8R ;ALB/RRG - AR WORKLOAD ASSIGNMENTS (PRINT) ;05-FEB-01
  1. ;;2.0;INTEGRATED BILLING;**123,159,192,739**;21-MAR-94;Build 3
  1. ;
  1. EN ; - Option entry point
  1. ;
  1. CLK ; - Select one, more, or all clerks to print
  1. W !!,"Run list for (S)pecific clerks or (A)ll clerks: ALL// "
  1. R X:DTIME G:'$T!(X["^") ENQ S:X="" X="A" S X=$E(X)
  1. I "SAsa"'[X S IBOFF=61 D HELP^IBJDF8H G CLK
  1. W " ",$S("Ss"[X:"SPECIFIC",1:"ALL") G:"Aa"[X DEV K IBSI
  1. CLK1 S DIC="^IBE(351.73,",DIC(0)="AEQMZ"
  1. S DIC("A")=" Select "_$S($G(IBSI):"another ",1:"")_"Clerk: "
  1. D ^DIC K DIC I Y'>0 G ENQ:'$G(IBSI),DEV
  1. I $D(IBSI(+Y)) D G CLK1
  1. . W !!?3,"Already selected. Choose another clerk.",!,*7
  1. S IBSI(+Y)="" S:'$G(IBSI) IBSI=1 G CLK1
  1. ;
  1. DEV ; - Select a device
  1. W !!,"This report requires an 80 column printer."
  1. S %ZIS="QM" D ^%ZIS G:POP ENQ
  1. I $D(IO("Q")) D G ENQ
  1. .S ZTRTN="PRINT^IBJDF8R",ZTDESC="IB - AR WORKLOAD ASSIGNMENTS LIST"
  1. .S ZTSAVE("IB*")="" D ^%ZTLOAD
  1. .I $G(ZTSK) W !!,"This job has been queued. The task no. is ",ZTSK,"."
  1. .E W !!,"Unable to queue this job."
  1. .K ZTSK,IO("Q") D HOME^%ZIS
  1. ;
  1. U IO
  1. ;
  1. PRINT ; - Print the AR Workload Assignments Report
  1. ;
  1. S IBQ=0 D NOW^%DTC S IBRUN=$$DAT2^IBOUTL(%)
  1. S IBPAG=0
  1. ;
  1. I '$D(^IBE(351.73,0)) D G ENQ
  1. . D @("HDR")
  1. . W !!,"There is no AR Workload Assignment information for the parameters selected."
  1. ;
  1. S IBPAG=0 D HDR G:IBQ ENQ
  1. ;
  1. I $G(IBSI) G PRINT1
  1. ;
  1. ; - print all clerks
  1. ;
  1. S (IBCLNUM,IBCLNAM,IBASNUM,IBPRO,IBASNDAT,IBBCAT,IBMIN,IBSUPER,IBEXCRC)=""
  1. ; retrieve clerk detail and print
  1. F S IBCLNUM=$O(^IBE(351.73,IBCLNUM)) Q:IBCLNUM="" D Q:IBQ
  1. . S IBCLDAT=$G(^IBE(351.73,IBCLNUM,0)) Q:IBCLDAT=""
  1. . S IBCLNAM=$P(^VA(200,$P(IBCLNUM,"^",1),0),"^",1),IBPRO=$P(IBCLDAT,"^",2)
  1. . W !!!,IBCLNAM,?40,"Productivity report only? "
  1. . W ?67,$S(IBPRO=0:"NO",1:"YES")
  1. . I IBPRO=1 Q
  1. . ; retrieve assignment data and print
  1. . F S IBASNUM=$O(^IBE(351.73,IBCLNUM,1,IBASNUM)) Q:IBASNUM="" D Q:IBQ
  1. . . S IBASNDAT=$G(^IBE(351.73,IBCLNUM,1,IBASNUM,0)) Q:IBASNDAT=""
  1. . . S IBBCAT=$P(IBASNDAT,"^",2),IBMIN=$P(IBASNDAT,"^",3)
  1. . . S IBSUPER=$P(IBASNDAT,"^",4),IBEXCRC=$P(IBASNDAT,"^",5)
  1. . . W !,"Assignment #: ",?15,IBASNUM,?20,"Bill Category: "
  1. . . W ?35,$E($P(^PRCA(430.2,IBBCAT,0),"^",1),1,18)
  1. . . W ?55,"Min Acct Bal: ",?69,$J($FN(IBMIN,",",2),10)
  1. . . W !,?20,"Supervisor: ",?35,$E($P($G(^VA(200,+IBSUPER,0)),"^",1),1,18)
  1. . . W ?55,"Exclude Reg Counsel: ",?75,$S(IBEXCRC=1:"YES",1:"NO")
  1. . . ; - Page Break
  1. . . I $Y>(IOSL-8) D PAUSE Q:IBQ D HDR Q:IBQ
  1. . . ; print first party parameters if present
  1. . . I $D(^IBE(351.73,IBCLNUM,1,IBASNUM,1)) D FIRST
  1. . . ; print third party parameters if present
  1. . . I $D(^IBE(351.73,IBCLNUM,1,IBASNUM,2)) D THIRD
  1. . . ;
  1. . . ; - Page Break
  1. . . I $Y>(IOSL-6) D PAUSE Q:IBQ D HDR Q:IBQ
  1. . . ;
  1. ;
  1. G ENQ:IBQ W !!,"------ End of Assignment List ------" D PAUSE
  1. G ENQ
  1. ;
  1. PRINT1 ; - print selected clerks only
  1. ;
  1. S (IBCLNUM,IBCLNAM,IBASNUM,IBPRO,IBASNDAT,IBBCAT,IBMIN,IBSUPER,IBEXCRC)=""
  1. ; retrieve clerk detail and print
  1. F S IBCLNUM=$O(IBSI(IBCLNUM)) Q:IBCLNUM="" D Q:IBQ
  1. . S IBCLDAT=$G(^IBE(351.73,IBCLNUM,0)) Q:IBCLDAT=""
  1. . S IBCLNAM=$P(^VA(200,$P(IBCLNUM,"^",1),0),"^",1),IBPRO=$P(IBCLDAT,"^",2)
  1. . W !!!,IBCLNAM,?40,"Productivity report only? "
  1. . W ?67,$S(IBPRO=0:"NO",1:"YES")
  1. . I IBPRO=1 Q
  1. . ; retrieve assignment data and print
  1. . F S IBASNUM=$O(^IBE(351.73,IBCLNUM,1,IBASNUM)) Q:IBASNUM="" D
  1. . . S IBASNDAT=$G(^IBE(351.73,IBCLNUM,1,IBASNUM,0)) Q:IBASNDAT=""
  1. . . S IBBCAT=$P(IBASNDAT,"^",2),IBMIN=$P(IBASNDAT,"^",3)
  1. . . S IBSUPER=$P(IBASNDAT,"^",4),IBEXCRC=$P(IBASNDAT,"^",5)
  1. . . W !,"Assignment #: ",?15,IBASNUM,?20,"Bill Category: "
  1. . . W ?35,$E($P(^PRCA(430.2,IBBCAT,0),"^",1),1,18)
  1. . . W ?55,"Min Acct Bal: ",?69,$J($FN(IBMIN,",",2),10)
  1. . . W !?20,"Supervisor: ",?35,$E($P($G(^VA(200,+IBSUPER,0)),"^",1),1,18)
  1. . . W ?55,"Exclude Reg Counsel: ",?75,$S(IBEXCRC=1:"YES",1:"NO")
  1. . . ; - page break
  1. . . I $Y>(IOSL-8) D PAUSE Q:IBQ D HDR Q:IBQ
  1. . . ; print first party parameters if present
  1. . . I $D(^IBE(351.73,IBCLNUM,1,IBASNUM,1)) D FIRST
  1. . . ; print third party parameters if present
  1. . . I $D(^IBE(351.73,IBCLNUM,1,IBASNUM,2)) D THIRD
  1. . . ; - page break
  1. . . I $Y>(IOSL-6) D PAUSE Q:IBQ D HDR Q:IBQ
  1. ;
  1. W !!,"------ End of Assignment List ------" D PAUSE
  1. ;
  1. ;
  1. ENQ D ^%ZISC
  1. K IBPAG,IBQ,%,X,Y,IBX,DIR,DIRUT,DUOUT,DTOUT,DIROUT
  1. K IBCLNAM,IBCLNUM,IBASNUM,IBPRO,IBASNDAT,IBBCAT,IBMIN,IBSUPER
  1. K IBEXCRC,IBFPDAT,IBTPDAT,IBTOR,IBSI,IBCLDAT,IBOFF,IBRUN
  1. Q
  1. ;
  1. HDR ; - Prints the Report Header
  1. ;
  1. I IBPAG>0 W @IOF,*13
  1. S IBPAG=$G(IBPAG)+1
  1. W !,"AR Workload Assignments List",?35,"Run Date: ",IBRUN
  1. W ?70,"Page: ",$J(IBPAG,3)
  1. W !,$$DASH(IOM,0) S IBQ=$$STOP^IBOUTL("AR Workload Assignments List")
  1. Q
  1. ;
  1. FIRST ; - Prints First Party Parameters
  1. ;
  1. S IBFPDAT=""
  1. S IBFPDAT=^IBE(351.73,IBCLNUM,1,IBASNUM,1)
  1. W !,"FIRST PARTY PARAMETERS:"
  1. W !,"Days Since Last Payment",?38,":",?40,$P(IBFPDAT,"^",1)
  1. W !,"First Patient Name",?38,":",?40,$P(IBFPDAT,"^",2)
  1. W !,"Last Patient Name",?38,":",?40,$P(IBFPDAT,"^",3)
  1. ;W !,"First Social Security Number",?38,":",?40,$P(IBFPDAT,"^",4);IB*2.0*739
  1. ;W !,"Last Social Security Number",?38,":",?40,$P(IBFPDAT,"^",5);IB*2.0*739
  1. Q
  1. ;
  1. THIRD ; - Prints Third Party Parameters
  1. ;
  1. S (IBTPDAT,IBTOR)=""
  1. S IBTPDAT=^IBE(351.73,IBCLNUM,1,IBASNUM,2),IBTOR=$P(IBTPDAT,"^",8)
  1. W !,"THIRD PARTY PARAMETERS:"
  1. W !,"Days Since Last Transaction",?38,":",?40,$P(IBTPDAT,"^",1)
  1. W !,"First Insurance Carrier",?38,":",?40,$P(IBTPDAT,"^",2)
  1. W !,"Last Insurance Carrier",?38,":",?40,$P(IBTPDAT,"^",3)
  1. W !,"First Patient Name",?38,":",?40,$P(IBTPDAT,"^",4)
  1. W !,"Last Patient Name",?38,":",?40,$P(IBTPDAT,"^",5)
  1. ;W !,"First Social Security Number",?38,":",?40,$P(IBTPDAT,"^",6);IB*2.0*739
  1. ;W !,"Last Social Security Number",?38,":",?40,$P(IBTPDAT,"^",7);IB*2.0*739
  1. W !,"Type of Receivable",?38,":"
  1. W ?40,$S(IBTOR=1:"Inpatient",IBTOR=2:"Outpatient",IBTOR=3:"Pharmacy Refill",IBTOR=4:"All Receivables",1:"")
  1. Q
  1. ;
  1. DASH(X,Y) ; - Return a dashed line.
  1. ; Input: X=Number of Columns (80 or 132), Y=Char to be printed
  1. ;
  1. Q $TR($J("",X)," ",$S(Y:"-",1:"="))
  1. ;
  1. PAUSE ; - Page break.
  1. ;
  1. I $E(IOST,1,2)'="C-" Q
  1. N IBX,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
  1. F IBX=$Y:1:(IOSL-3) W !
  1. S DIR(0)="E" D ^DIR S:$D(DIRUT)!($D(DUOUT)) IBQ=1
  1. Q
  1. ;
  1. DT(X) ; - Return date.
  1. ; Input: X=Date in Fileman format
  1. ; Output: Z=Date in MMDDYY format
  1. ;
  1. Q $E(X,4,7)_$E(X,2,3)