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

IBCMDT3.m

Go to the documentation of this file.
  1. IBCMDT3 ;ALB/VD - INSURANCE PLANS MISSING DATA REPORT (PRINT) ; 10-APR-15
  1. ;;2.0;INTEGRATED BILLING ;**549**; 10-APR-15;Build 54
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; Print the report.
  1. ; Required Input: Global print array ^TMP($J,"PR"
  1. ;
  1. ;
  1. EN ; - Entry point to print report
  1. N EORMSG,IBHDT,NODATA
  1. S EORMSG="*** END OF REPORT ***"
  1. D NOW^%DTC S IBHDT=$$DAT2^IBOUTL($E(%,1,12))
  1. S NODATA=1
  1. D PRINT
  1. K ^TMP($J,"PR"),^TMP("IBCMDT",IBNMSPC)
  1. I NODATA D
  1. . N IBPAG
  1. . S IBPAG=0
  1. . D COMP
  1. W !!!,EORMSG
  1. D PAUSE
  1. ;
  1. I $D(ZTQUEUED) S ZTREQ="@" Q
  1. ; Close Device
  1. D ^%ZISC
  1. Q
  1. ;
  1. PRINT ; Print report
  1. ; Input: NODATA - Set to 1 initially
  1. ; Output: NODATE - Set to 1 if at least one Insurance Company
  1. ; with data found
  1. N CVLMRC,CVLPRT,CVSWT,IBC,IBCVLT,IBI,IBP,IBPAG,IBQUIT,NEWIC,POSWT,%
  1. S (IBI,IBQUIT,IBPAG,CVLPRT,POSWT)=0,IBCVLT=""
  1. F S IBI=$O(^TMP($J,"PR",IBI)) Q:('IBI!IBQUIT) D
  1. . S IBC=$G(^TMP($J,"PR",IBI)),POSWT=+$P(IBC,U,1)
  1. . I $D(^TMP($J,"PR",IBI))=1 Q
  1. . S NODATA=0
  1. . D COMP D Q:IBQUIT
  1. . . S IBP=0
  1. . . F S IBP=$O(^TMP($J,"PR",IBI,IBP)) Q:'IBP D Q:IBQUIT
  1. . . . S IBPD=$G(^TMP($J,"PR",IBI,IBP))
  1. . . . I $Y>(IOSL-5) D PAUSE Q:IBQUIT D COMP
  1. . . . S CVSWT=1 D PLAN
  1. . . . S IBCVLT=""
  1. . . . F S IBCVLT=$O(^TMP($J,"PR",IBI,IBP,IBCVLT)) Q:IBCVLT="" D Q:IBQUIT
  1. . . . . S CVLMRC=$G(^TMP($J,"PR",IBI,IBP,IBCVLT))
  1. . . . . I +CVSWT D CVLMHD S CVSWT=0
  1. . . . . W !?4,$P(CVLMRC,U,1),?30,$P(CVLMRC,U,2),?50,$P(CVLMRC,U,3)
  1. . . . . S CVLPRT=1
  1. ;
  1. K IBC,IBCVLM,IBI,IBJJ,IBQUIT,IBP,IBPAG,IBPD,IBS,IBSD
  1. Q
  1. ;
  1. COMP ; Print Company header
  1. ; Input: NODATA - 1 if no data was found
  1. I $E(IOST,1,2)="C-"!(IBPAG) W @IOF
  1. S IBPAG=IBPAG+1
  1. W !,"INSURANCE PLANS MISSING DATA"
  1. W ?80,IBHDT,?110,"Page: ",IBPAG
  1. W !,$G(SUBHD),!
  1. I +$G(NODATA) D Q
  1. . W !!!,"--- No Data To Report ---",!
  1. ;
  1. ; - sub-header
  1. W !?1,$P(IBC,U,2)_" "_$P(IBC,U,3)_" "_$P(IBC,U,4)
  1. I +POSWT W ?90,"PRESCRIPTION ONLY"
  1. S NEWIC=1
  1. Q
  1. ;
  1. PLAN ; Print plan information.
  1. I CVLPRT W ! S CVLPRT=0
  1. I +NEWIC D
  1. . W !!?2,"GROUP NUMBER",?20,"GROUP NAME",?46,"TYPE OF PLAN",?62,"ELEC PLAN",?78,"FTF"
  1. . W:+$G(POSWT) ?98,"BIN",?109,"PCN"
  1. . W !?2,"------------",?20,"----------",?46,"------------",?62,"---------",?78,"---"
  1. . W:+$G(POSWT) ?98,"---",?109,"---"
  1. W !?2,$P(IBPD,U,2),?20,$E($P(IBPD,U,3),1,25),?46,$E($P(IBPD,U,4),1,15)
  1. W ?62,$E($P(IBPD,U,5),1,15),?78,$P(IBPD,U,6)
  1. W:+$G(POSWT) ?98,$P(IBPD,U,7),?109,$P(IBPD,U,8)
  1. S NEWIC=0
  1. Q
  1. ;
  1. CVLMHD ; Print Coverage Limit sub-header
  1. W !!?4,"Coverage",?30,"Effective Date",?50,"Covered?"
  1. W !?4,"--------",?30,"--------------",?50,"--------"
  1. Q
  1. ;
  1. PAUSE ; Pause for screen output.
  1. Q:$E(IOST,1,2)'["C-"
  1. F IBJJ=$Y:1:(IOSL-7) W !
  1. S DIR(0)="E" D ^DIR K DIR
  1. I $D(DIRUT)!($D(DUOUT)) S IBQUIT=1 K DIRUT,DTOUT,DUOUT
  1. Q