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