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 Apr 09, 2024@21:18:41 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
