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

IBOCPDS.m

Go to the documentation of this file. 
  1. IBOCPDS ;ALB/ARH - CLERK PRODUCTIVITY REPORT (SUMMARY) ;10/8/91
  1.  ;;2.0;INTEGRATED BILLING;**44,118,155,342**;21-MAR-94;Build 18
  1.  ;
  1. EN ; - Get parameters then run the report.
  1.  D ORDER^IBOCPD I IBQUIT G EXIT
  1.  D HOME^%ZIS
  1.  S IBHDR="CLERK PRODUCTIVITY SUMMARY REPORT" W @IOF,?22,IBHDR,!!
  1.  S IBFLD="Date "_$S(IBORDER="E":"Entered",IBORDER="A":"Authorized",1:"First Printed")
  1.  D RANGE^IBOCPD I IBQUIT G EXIT
  1.  ;
  1.  ; - Print without clerks' names?
  1.  S DIR(0)="Y",DIR("B")="NO",DIR("?")="^D HLP^IBOCPDS" W !
  1.  S DIR("A")="Do you want to print the summary without the clerks' names"
  1.  D ^DIR K DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) G EXIT
  1.  S IBNCLK=+Y K DIR,DIROUT,DTOUT,DUOUT,DIRUT
  1.  ;
  1. DEV ; - Get the device.
  1.  W !!,"Report requires 132 columns."
  1.  S %ZIS="QM",%ZIS("A")="OUTPUT DEVICE: " D ^%ZIS G:POP EXIT
  1.  I $D(IO("Q")) S ZTRTN="ENT^IBOCPDS",ZTDESC="Clerk Productivity Summary Report",ZTSAVE("IB*")="" D ^%ZTLOAD K IO("Q") G EXIT
  1.  U IO
  1.  ;***
  1.  ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOCPDS" D T1^%ZOSV ;stop rt clock
  1.  ;
  1. ENT ; - Find, save, and print the data that satisfies the search parameters
  1.  ;   entry for tasked jobs.
  1.  ;***
  1.  ;S XRTL=$ZU(0),XRTN="IBOCPDS-2" D T0^%ZOSV ;start rt clock
  1.  K ^TMP("IB",$J),IBMRAUSR
  1.  S IBCDT=IBBEG-.001,IBE=IBEND+.3,U="^",IBQUIT=0
  1.  S IBINDX=$S(IBORDER="E":"APD",IBORDER="A":"APD3",1:"AP")
  1.  F  S IBCDT=$O(^DGCR(399,IBINDX,IBCDT)) Q:IBCDT=""!(IBCDT>IBE)!IBQUIT  S IFN=0 D  S IBQUIT=$$STOP
  1.  .F  S IFN=$O(^DGCR(399,IBINDX,IBCDT,IFN)) Q:'IFN  D FILE
  1.  ;
  1.  ; 5/28/04 - esg - MRA project - patch 155 - get MRA request data
  1.  ;
  1.  S IBCDT=IBBEG-.001,IBE=IBEND+.3
  1.  F  S IBCDT=$O(^DGCR(399,"APM",IBCDT)) Q:'IBCDT!(IBCDT>IBE)!IBQUIT  D
  1.  . S IBQUIT=$$STOP Q:IBQUIT
  1.  . S IFN=0
  1.  . F  S IFN=$O(^DGCR(399,"APM",IBCDT,IFN)) Q:'IFN  D FILEMRA
  1.  . Q
  1.  ;
  1.  I $D(^TMP("IB",$J)),'IBQUIT D PRINT
  1.  ;
  1. EXIT ; - Clean up and quit.
  1.  K ^TMP("IB",$J)
  1.  ;***
  1.  ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOCPDS" D T1^%ZOSV ;stop rt clock
  1.  I $D(ZTQUEUED) Q
  1.  K IBE,IBBEG,IBBEGE,IBCANC,IBEND,IBENDE,IBCDT,IFN,IBRT,IBCLK,IBNCLK,IBCT
  1.  K IBTD,IBNODE,IBPGN,IBLN,IBHDR,IBINDX,IBFLD,IBQUIT,IBORDER,IBI,X,Y
  1.  K DTOUT,DUOUT,DIRUT,DIROUT,IBMRAUSR
  1.  D ^%ZISC
  1.  Q
  1.  ;
  1. FILE ; - Save the data in sorted order in a temporary file.
  1.  S IBRT=$P($G(^DGCR(399,IFN,0)),U,7) I 'IBRT Q
  1.  S IBCLK=$P($G(^VA(200,+$P($G(^DGCR(399,IFN,"S")),U,$S(IBORDER="E":2,IBORDER="A":11,IBORDER="P":13,1:0)),0)),U) I IBCLK="" Q
  1.  S IBTD=$P($G(^DGCR(399,IFN,"U1")),U,1)-$P($G(^DGCR(399,IFN,"U1")),U,2)
  1.  S IBCANC=($P(^DGCR(399,IFN,0),U,13)=7)
  1.  S IBNODE=$G(^TMP("IB",$J)),$P(^($J),U,1,4)=($P(IBNODE,U,1)+1)_U_($P(IBNODE,U,2)+IBTD)_U_($P(IBNODE,U,3)+$S('IBCANC:0,1:1))_U_($P(IBNODE,U,4)+$S('IBCANC:0,1:IBTD))
  1.  S IBNODE=$G(^TMP("IB",$J,IBCLK)),$P(^(IBCLK),U,1,4)=($P(IBNODE,U,1)+1)_U_($P(IBNODE,U,2)+IBTD)_U_($P(IBNODE,U,3)+$S('IBCANC:0,1:1))_U_($P(IBNODE,U,4)+$S('IBCANC:0,1:IBTD))
  1.  S IBNODE=$G(^TMP("IB",$J,IBCLK,IBRT)),$P(^(IBRT),U,1,4)=($P(IBNODE,U,1)+1)_U_($P(IBNODE,U,2)+IBTD)_U_($P(IBNODE,U,3)+$S('IBCANC:0,1:1))_U_($P(IBNODE,U,4)+$S('IBCANC:0,1:IBTD))
  1.  S IBNODE=$G(^TMP("IB",$J,"~~")),$P(^("~~"),U,1,4)=($P(IBNODE,U,1)+1)_U_($P(IBNODE,U,2)+IBTD)_U_($P(IBNODE,U,3)+$S('IBCANC:0,1:1))_U_($P(IBNODE,U,4)+$S('IBCANC:0,1:IBTD))
  1.  S IBNODE=$G(^TMP("IB",$J,"~~",IBRT)),$P(^(IBRT),U,1,4)=($P(IBNODE,U,1)+1)_U_($P(IBNODE,U,2)+IBTD)_U_($P(IBNODE,U,3)+$S('IBCANC:0,1:1))_U_($P(IBNODE,U,4)+$S('IBCANC:0,1:IBTD))
  1.  ;
  1.  ; 7/26/04 - ESG - MRA Project - Capture division data for MRA authorizer user
  1.  I IBCLK["AUTHORIZER,IB MRA"!(IBCLK["POSTMASTER")  D
  1.  . N DIV
  1.  . S DIV=+$P($G(^DGCR(399,IFN,0)),U,22)    ; division pointer
  1.  . S DIV=$P($G(^DG(40.8,DIV,0)),U,1)       ; division name
  1.  . I DIV="" S DIV="~UNKNOWN"
  1.  . S IBNODE=$G(IBMRAUSR(IBCLK,IBRT,DIV))
  1.  . S $P(IBMRAUSR(IBCLK,IBRT,DIV),U,1,4)=($P(IBNODE,U,1)+1)_U_($P(IBNODE,U,2)+IBTD)_U_($P(IBNODE,U,3)+$S('IBCANC:0,1:1))_U_($P(IBNODE,U,4)+$S('IBCANC:0,1:IBTD))
  1.  . Q
  1.  Q
  1.  ;
  1. FILEMRA ; Capture and file MRA data into the scratch global
  1.  ; 9/9/03 - ESG - MRA Project
  1.  NEW IBRT,IBTD,MRAUSR,IBNODE
  1.  S IBRT=$P($G(^DGCR(399,IFN,0)),U,7) I 'IBRT G FMX
  1.  S IBTD=$P($G(^DGCR(399,IFN,"U1")),U,1)-$P($G(^DGCR(399,IFN,"U1")),U,2)
  1.  S MRAUSR=+$P($G(^DGCR(399,IFN,"S")),U,8)
  1.  I 'MRAUSR G FMX
  1.  S MRAUSR=$P($G(^VA(200,MRAUSR,0)),U,1)
  1.  I MRAUSR="" G FMX
  1.  S IBNODE=$G(^TMP("IB",$J)),$P(^($J),U,5,6)=($P(IBNODE,U,5)+1)_U_($P(IBNODE,U,6)+IBTD)
  1.  S IBNODE=$G(^TMP("IB",$J,MRAUSR)),$P(^(MRAUSR),U,5,6)=($P(IBNODE,U,5)+1)_U_($P(IBNODE,U,6)+IBTD)
  1.  S IBNODE=$G(^TMP("IB",$J,MRAUSR,IBRT)),$P(^(IBRT),U,5,6)=($P(IBNODE,U,5)+1)_U_($P(IBNODE,U,6)+IBTD)
  1.  S IBNODE=$G(^TMP("IB",$J,"~~")),$P(^("~~"),U,5,6)=($P(IBNODE,U,5)+1)_U_($P(IBNODE,U,6)+IBTD)
  1.  S IBNODE=$G(^TMP("IB",$J,"~~",IBRT)),$P(^(IBRT),U,5,6)=($P(IBNODE,U,5)+1)_U_($P(IBNODE,U,6)+IBTD)
  1.  ;
  1. FMX ;
  1.  Q
  1.  ;
  1.  ;
  1. PRINT ; - Print the report from the temp sort file to the appropriate device.
  1.  N IBT,IBH1,L1,L2,T1,T2,T3,T4,T5,T6
  1.  S IBCLK="",IBPGN=0
  1.  S L1=7        ; length of count fields
  1.  S L2=13       ; length of dollar amount fields
  1.  S T1=50       ; tab stop 1 - total count
  1.  S T2=59       ; tab stop 2 - total dollar amount
  1.  S T3=78       ; tab stop 3 - cancelled count
  1.  S T4=87       ; tab stop 4 - cancelled dollar amount
  1.  S T5=106      ; tab stop 5 - MRA request count
  1.  S T6=115      ; tab stop 6 - MRA request dollar amount
  1.  D HDR F  S IBCLK=$O(^TMP("IB",$J,IBCLK)) Q:IBCLK=""!(IBQUIT)  D LINE
  1.  S IBT=$G(^TMP("IB",$J)) I IBQUIT Q
  1.  W !!,"TOTAL:",?T1,$J(+$P(IBT,U,1),L1),?T2,$J($P(IBT,U,2),L2,2),?T3,$J(+$P(IBT,U,3),L1),?T4,$J($P(IBT,U,4),L2,2),?T5,$J(+$P(IBT,U,5),L1),?T6,$J($P(IBT,U,6),L2,2),!
  1.  D NOTE^IBOCPD,PAUSE
  1.  Q
  1.  ;
  1. LINE ; - Print all data for a particular clerk.
  1.  N IBT,DIV
  1.  S IBLN=IBLN+1 I IBNCLK S IBCT=$G(IBCT)+1
  1.  I IBCLK'="~~" W !,$S(IBNCLK:"CLERK #"_IBCT,1:$E(IBCLK,1,25))
  1.  E  W !,"RATE TYPE TOTALS"
  1.  S IBRT="" F  S IBRT=$O(^TMP("IB",$J,IBCLK,IBRT)) Q:IBRT=""!(IBQUIT)  D  Q:IBQUIT  S IBLN=IBLN+1 I IBLN>(IOSL-7) D PAUSE,HDR:'IBQUIT
  1.  . S IBT=$G(^TMP("IB",$J,IBCLK,IBRT))
  1.  . W ?30,$E($P(^DGCR(399.3,IBRT,0),U,1),1,20),?T1,$J(+$P(IBT,U,1),L1),?T2,$J($P(IBT,U,2),L2,2),?T3,$J(+$P(IBT,U,3),L1),?T4,$J($P(IBT,U,4),L2,2)
  1.  . W ?T5,$J(+$P(IBT,U,5),L1),?T6,$J($P(IBT,U,6),L2,2),!
  1.  . ; divisional display
  1.  . I '$D(IBMRAUSR(IBCLK,IBRT)) Q
  1.  . W ?T1,"  -----",?T2,"  -----------",?T3,"  -----",?T4,"  -----------",?T5,"  -----",?T6,"  -----------"
  1.  . S DIV=""
  1.  . F  S DIV=$O(IBMRAUSR(IBCLK,IBRT,DIV)) Q:DIV=""!IBQUIT  D
  1.  .. S IBLN=IBLN+1 I IBLN>(IOSL-7) D PAUSE,HDR:'IBQUIT
  1.  .. I IBQUIT Q
  1.  .. S IBT=$G(IBMRAUSR(IBCLK,IBRT,DIV))
  1.  .. W !?7,DIV,?T1,$J(+$P(IBT,U,1),L1),?T2,$J($P(IBT,U,2),L2,2),?T3,$J(+$P(IBT,U,3),L1),?T4,$J($P(IBT,U,4),L2,2),?T5,$J(+$P(IBT,U,5),L1),?T6,$J($P(IBT,U,6),L2,2)
  1.  .. Q
  1.  . I IBQUIT Q
  1.  . W !
  1.  . Q
  1.  ;
  1.  I IBQUIT Q
  1.  W ?T1,"  -----",?T2,"  -----------",?T3,"  -----",?T4,"  -----------"
  1.  W ?T5,"  -----",?T6,"  -----------"
  1.  S IBT=$G(^TMP("IB",$J,IBCLK))
  1.  W !,?30,"SUBTOTAL:",?T1,$J(+$P(IBT,U,1),L1),?T2,$J($P(IBT,U,2),L2,2),?T3,$J(+$P(IBT,U,3),L1),?T4,$J($P(IBT,U,4),L2,2)
  1.  W ?T5,$J(+$P(IBT,U,5),L1),?T6,$J($P(IBT,U,6),L2,2),!
  1.  S IBLN=IBLN+2
  1.  Q
  1.  ;
  1. HDR ; - Print the report header.
  1.  N IBH1,IBH2
  1.  S IBQUIT=$$STOP Q:IBQUIT  S IBPGN=IBPGN+1,IBLN=7
  1.  D NOW^%DTC S Y=$E(%,1,12) D DD^%DT S IBCDT=$P(Y,"@",1)_"  "_$P(Y,"@",2)
  1.  I IBPGN>1!($E(IOST,1,2)["C-") W @IOF
  1.  S IBH1=$S(IBORDER="E":"ENTERED",IBORDER="A":"AUTHORIZED",1:"FIRST PRINTED")
  1.  W "CLERK PRODUCTIVITY SUMMARY FOR BILLS ",IBH1," ",IBBEGE," - ",IBENDE I IOM<85 W !
  1.  S IBH2=$S(IBORDER'="P":IBH1,1:"PRINTED") S:IBORDER="E" IBH1="ENTERED/EDITED"
  1.  W ?(IOM-30),IBCDT,?(IOM-8),"PAGE ",IBPGN,!
  1.  W !,?T1,"---",$S(IBORDER'="A":"-",1:""),"TOTAL ",IBH2,"---",$S(IBORDER'="A":"--",1:""),?T3,"-",$S(IBORDER'="A":"-",1:""),IBH2," CANCELLED-",$S(IBORDER'="A":"--",1:"")
  1.  W ?T5,"-----MRA REQUESTS-----"
  1.  W !,IBH1," BY",?30,"RATE TYPE",?T1,$J("COUNT",L1),?T2,$J("AMOUNT",L2),?T3,$J("COUNT",L1),?T4,$J("AMOUNT",L2)
  1.  W ?T5,$J("COUNT",L1),?T6,$J("AMOUNT",L2),!
  1.  S IBI="",$P(IBI,"-",IOM+1)="" W IBI,!
  1.  Q
  1.  ;
  1. PAUSE ; - Pause at end of screen if beeing displayed on a terminal.
  1.  Q:$E(IOST,1,2)'["C-"
  1.  S DIR(0)="E" D ^DIR K DIR
  1.  I $D(DUOUT)!($D(DIRUT)) S IBQUIT=1
  1.  Q
  1.  ;
  1. STOP() ; - Determine if user has requested the queued report to stop.
  1.  I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ I +$G(IBPGN) W !,"***TASK STOPPED BY USER***"
  1.  Q +$G(ZTSTOP)
  1.  ;
  1. HLP ; - "Do you want to print..." prompt.
  1.  W !!,"Select: '<CR>' to print the summary with the clerks' actual names"
  1.  W !?11,"'Y' to print the summary with an identifier ('CLERK #xxx')"
  1.  W !?15,"in place of the clerks' names",!?11,"'^' to quit"
  1.  Q