IBCNGP1 ;ALB/CKB - REPORT OF COVERAGE LIMITATIONS (COMPILE/PRINT) ; 07-OCT-2021
;;2.0;INTEGRATED BILLING;**702**;21-MAR-94;Build 53
;;Per VA Directive 6402, this routine should not be modified.
;
COMPILE(IBCNGPRTN,IBCNGP) ; Entry Point called from EN^XUTMDEVQ.
; IBCNGPRTN = Routine name for ^TMP($J,...
; IBCNGP = Array of params
; Input:
; IBCNGP("IBI") 0-Selected, 1-All Insurance Companies
; IBCNGP("IBIA") 0-Active, 1-Both Active and Inactive, 2-Inactive Insurance Companies
; IBCNGP("IBIP") 0-Selected, 1-All Group Plans
; IBCNGP("IBIPA") 0-Active, 1-Both Active and Inactive, 2-Inactive Group Plans
; IBCNGP("IBIGN") 1-Group Name, 2-Group Number, 3-Both Group Name and Group Number
; IBCNGP("IBFIL") A^B^C where"
; A - 1-Begin with, 2-Contains, 3-Range
; B - A=1 Begin with text, A=2 Contains text, A=3 Range start text
; C - only if A=3 Range End text
; IBCNGP("IBICS") 1-Covered, 2-Not Covered, 3-Conditional
; 4-By Default (blank status), 5-All Coverage Statuses
; IBCNGP("IBOUT") E-EXCEL, R-REPORT
;
; ^TMP("IBCNGP",$J,"INS",ICT)=IEN of the selected Insurance Company, file 36
; ICT - count of Insurance Companies
; ^TMP("IBCNGP",$J,"INS",ICT,"GRP",GCT)=IEN of the selected Group Plan, file 355.3
; GCT - count of Group Plans
;
; Compile and Print Report
N GDATA,GCT,GIEN,IBCT,IBPGN,ICT,IIEN,PLANOK
K ^TMP($J,"PR")
;
I $G(IOST)["C-",IBCNGP("IBOUT")="R" W !,"Compiling report data ...",!
;
;If ALL Group Plans, add groups to ^TMP("IBCNGP")
I IBCNGP("IBIP") D
. S IBCT=""
. F S IBCT=$O(^TMP("IBCNGP",$J,"INS",IBCT)) Q:IBCT="" D
. . S IIEN=^TMP("IBCNGP",$J,"INS",IBCT)
. . I $D(^IBA(355.3,"B",IIEN)) D
. . . S GCT=0
. . . S GIEN=0 F S GIEN=$O(^IBA(355.3,"B",IIEN,GIEN)) Q:'GIEN D
. . . . ; checks to see if Group Plan should be included on the report
. . . . K GDATA
. . . . D GETS^DIQ(355.3,GIEN_",",".05;.06;.07;.08;.09;.11;2.01;2.02","EI","GDATA")
. . . . S PLANOK=$$PLANOK^IBCNSU21(.GDATA,IBCNGP("IBIPA"),IBCNGP("IBIGN"),IBCNGP("IBFIL"))
. . . . I 'PLANOK Q
. . . . S GCT=GCT+1
. . . . S ^TMP("IBCNGP",$J,"INS",IBCT,"GRP",GCT)=GIEN
;
S ICT=0
F S ICT=$O(^TMP("IBCNGP",$J,"INS",ICT)) Q:'ICT D
. S IIEN=^TMP("IBCNGP",$J,"INS",ICT)
. S GCT=0
. F S GCT=$O(^TMP("IBCNGP",$J,"INS",ICT,"GRP",GCT)) Q:'GCT D
. . S GIEN=^TMP("IBCNGP",$J,"INS",ICT,"GRP",GCT)
. . D GETDATA
;
D PRINT
;
K ^TMP("IBCNGP",$J)
Q
;
GETDATA ; Get Insurance Company and Group Plan data
; Input: IIEN - IEN of the Insurance Company, file 36
; GIEN - IEN of the Group Plan, file 355.3
; Output: ^TMP($J,"PR",INSNAME,ICT,GNAME,GCT,IBCAT,CCT)) - C1^C2^..^C4 Where:
; INSNAME - Insurance Company name
; ICT - Insurance Company counter from ^TMP("IBCNGP")
; GNAME - Group Plan name
; GCT - Group Plans counter from ^TMP("IBCNGP")
; IBCAT - Coverage Category
; CCT - Coverage Category counter
; C1=Coverage Category, C2=Effective Date
; C3=Coverage Status, C4=Limitation Comment
;
N CATARR,CCT,CDATA,CTR,GINACT,GIND,GNAME,GNUM,GTYP,I,IBCAT,IBCOV,IBCSTA,IBDT,IBEFDT,IBINS
N IBLIMCOM,IBRECDT,IBRECN,INSNAME,PRINT,STATE,STATECD,XX
;
; NOTE: If a category has at least one instance where the Coverage matches the Coverage
; selected by the user, all instances for that Category will be displayed on the report.
;
; Compile Plans Coverage Limitation info
; File# 355.31 PLAN LIMITATION CATEGORY contains ALL coverage categories
F I=1:1:$O(^IBE(355.31,"B"),-1) S IBCAT=I D
. ; If the Category doesn't exist for the Plan the Coverage Status is BY DEFAULT
. I '$D(^IBA(355.32,"APCD",GIEN,I)) D Q
. . S IBCSTA="BY DEFAULT" ; Coverage Status
. . S IBCOV=$$GET1^DIQ(355.31,I,.01,"E") ; Coverage Category
. . S CATARR(IBCAT,0,0)=IBCOV_U_U_IBCSTA
. . D COVOK
. S IBRECDT=""
. F S IBRECDT=$O(^IBA(355.32,"APCD",GIEN,IBCAT,IBRECDT)) Q:IBRECDT="" D
. . S IBRECN=""
. . F S IBRECN=$O(^IBA(355.32,"APCD",GIEN,IBCAT,IBRECDT,IBRECN)) Q:IBRECN="" D
. . . S IBCOV=$$GET1^DIQ(355.32,IBRECN,.02) ; Coverage Category
. . . S IBEFDT=$$DAT3^IBOUTL($$GET1^DIQ(355.32,IBRECN,.03,"I")) ; Effective Date
. . . S IBCSTA=$$GET1^DIQ(355.32,IBRECN,.04,"I") ; Coverage Status
. . . S IBCSTA=$S(IBCSTA="":"BY DEFAULT",IBCSTA=0:"NO",IBCSTA=1:"YES",1:"CONDITIONAL")
. . . S IBLIMCOM=""
. . . I $O(^IBA(355.32,IBRECN,2,0))'="" S IBLIMCOM="YES" ; Limit Comments?
. . . ; Build local array by Category and Date
. . . S CATARR(IBCAT,IBRECDT,IBRECN)=IBCOV_U_IBEFDT_U_IBCSTA_U_IBLIMCOM
. . . ; Check Coverage to see if it should be displayed
. . . D COVOK
;
CATARR ; Loop thru CATARR, add the Categories that should be displayed to the Print array.
S IBCAT=0 F S IBCAT=$O(CATARR(IBCAT)) Q:IBCAT="" D
. I $G(CATARR(IBCAT))'=1 Q
. S CCT=0
. S IBDT="" F S IBDT=$O(CATARR(IBCAT,IBDT)) Q:IBDT="" D
. . S CTR="" F S CTR=$O(CATARR(IBCAT,IBDT,CTR)) Q:CTR="" D
. . . S CDATA=CATARR(IBCAT,IBDT,CTR)
. . . S IBCOV=$P(CDATA,U)
. . . S IBEFDT=$P(CDATA,U,2)
. . . S IBCSTA=$P(CDATA,U,3)
. . . S IBLIMCOM=$P(CDATA,U,4)
. . . S CCT=CCT+1
. . . ; The Insurance & Group info only need to be added once (the first category)
. . . ; Build the Print array
. . . I CCT=1 D GETINS,GETGRP ; builds Insurance & Group Plan print array
. . . S ^TMP($J,"PR",INSNAME,ICT,GNAME,GCT,IBCAT,CCT)=IBCOV_U_IBEFDT_U_IBCSTA_U_IBLIMCOM
Q
;
GETINS ; Get Insurance info
S INSNAME=$$GET1^DIQ(36,IIEN,.01)
S $P(IBINS,U)=INSNAME
S $P(IBINS,U,2)=$S($$GET1^DIQ(36,IIEN,.111)'="":$$GET1^DIQ(36,IIEN,.111),1:"<STREET ADDR 1 MISSING>")
S $P(IBINS,U,3)=$$GET1^DIQ(36,IIEN,.114)
S XX=$$GET1^DIQ(36,IIEN,.115) I XX'="" S STATECD=$O(^DIC(5,"B",XX,""))
S $P(IBINS,U,4)=$S(XX'="":$P($G(^DIC(5,STATECD,0)),U,2),1:"<STATE MISSING>")
S $P(IBINS,U,5)=$$GET1^DIQ(36,IIEN,.116)
S ^TMP($J,"PR",INSNAME,ICT)=IBINS
Q
;
GETGRP ; Get Group Plan info
S GIND=$$GET1^DIQ(355.3,GIEN,.1,"I")
S GINACT=$$GET1^DIQ(355.3,GIEN,.11,"I")
S GNAME=$S($$GET1^DIQ(355.3,GIEN,2.01)'="":$$GET1^DIQ(355.3,GIEN,2.01),1:"<NO GROUP NAME>")
S GNUM=$S($$GET1^DIQ(355.3,GIEN,2.02)'="":$$GET1^DIQ(355.3,GIEN,2.02),1:"<NO GROUP NUMBER>")
; Add '+'=individual and/or '*'=inactive
I GIND'="" S GNAME="+"_GNAME
I GINACT S GNUM="*"_GNUM
S GTYP=$S($$GET1^DIQ(355.3,GIEN,.09)'="":$$GET1^DIQ(355.3,GIEN,.09),1:"<NO TYPE OF PLAN>")
S ^TMP($J,"PR",INSNAME,ICT,GNAME,GCT)=GNAME_U_GNUM_U_GTYP
Q
;
COVOK ; If the Coverage matches what the user selected, flag the Category and set PRINT=1.
; This Coverage, it's Insurance and Group, will be displayed on the report.
; IBCNGP("IBICS") - 1-Covered, 2-Not Covered, 3-Conditional
; 4-By Default (blank status), 5-All Coverage Statuses
I IBCNGP("IBICS")=5 S CATARR(IBCAT)=1,PRINT=1 Q
I IBCNGP("IBICS")=1,IBCSTA="YES" S CATARR(IBCAT)=1,PRINT=1
I IBCNGP("IBICS")=2,IBCSTA="NO" S CATARR(IBCAT)=1,PRINT=1
I IBCNGP("IBICS")=3,IBCSTA="CONDITIONAL" S CATARR(IBCAT)=1,PRINT=1
I IBCNGP("IBICS")=4,IBCSTA="BY DEFAULT" S CATARR(IBCAT)=1,PRINT=1
Q
;
;============================PRINT==================================
PRINT ;
; Input: ^TMP($J,"PR",INSNAME,ICT,GNAME,GCT,IBCAT,CCT)) - C1^C2^..^C4 Where:
; INSNAME - Insurance Company name
; ICT - Insurance Company counter from ^TMP("IBCNGP")
; GNAME - Group Plan name
; GCT - Group Plans counter from ^TMP("IBCNGP")
; IBCAT - Coverage Category
; CCT - Coverage Category counter
; C1=Coverage Category, C2=Effective Date
; C3=Coverage Status, C4=Limitation Comment
;
N CRT,DASHES,EORMSG,FIRST,HDRDATE,HDRNAME,IBPGC,IBPXT,MAXCNT,NONEMSG,SPACES,STOP,ZTSTOP
S (STOP,ZSTOP)=0
S EORMSG="*** End of Report ***"
S NONEMSG="* * * N o D a t a F o u n d * * *"
S HDRNAME="COVERAGE LIMITATION REPORT"
D NOW^%DTC
S HDRDATE=$$DAT2^IBOUTL($E(%,1,12))
S $P(DASHES,"-",132)=""
S $P(SPACES," ",130)=""
S (IBPXT,IBPGC)=0
S MAXCNT=IOSL-3,CRT=1
I 'IOST["C-" S MAXCNT=IOSL-6,CRT=0
;
; Print report
D PRT Q:(IBPXT!$G(ZTSTOP))
I CRT,IBPGC>0,$E(IOST,1,2)["C-" D
. I MAXCNT<51 F LIN=1:1:(MAXCNT-$Y) W !
. S DIR(0)="E" D ^DIR K DIR
I IBCNGP("IBOUT")="E",CRT,$E(IOST,1,2)["C-" S DIR(0)="E" D ^DIR K DIR
EXIT ; PRINT exit
K ^TMP($J,"PR")
Q
;
PRT ; Print report
N BLANK,CAT,CCT,CDATA,DISPDATA,GCT,GPLAN,GDATA,ICT,IDATA,INS
N GDATALN,IDATALN ;702/DTG line spacing
;
; EXCEL Format
I IBCNGP("IBOUT")="E" D G PRTEX
. D EHDR ; EXCEL Header
. I '$D(^TMP($J,"PR")) D G PRTEX
. . W !,NONEMSG ; No Data Found
. S INS=0 F S INS=$O(^TMP($J,"PR",INS)) Q:INS="" D
. . S ICT=0 F S ICT=$O(^TMP($J,"PR",INS,ICT)) Q:ICT="" D
. . . S IDATA=^TMP($J,"PR",INS,ICT)
. . . S GPLAN=0 F S GPLAN=$O(^TMP($J,"PR",INS,ICT,GPLAN)) Q:GPLAN="" D
. . . . S GCT=0 F S GCT=$O(^TMP($J,"PR",INS,ICT,GPLAN,GCT)) Q:GCT="" D
. . . . . S GDATA=^TMP($J,"PR",INS,ICT,GPLAN,GCT)
. . . . . S CAT=0 F S CAT=$O(^TMP($J,"PR",INS,ICT,GPLAN,GCT,CAT)) Q:CAT="" D
. . . . . . S CCT=0 F S CCT=$O(^TMP($J,"PR",INS,ICT,GPLAN,GCT,CAT,CCT)) Q:CCT="" D
. . . . . . . K DISPDATA ; Init dispdata
. . . . . . . S CDATA=^TMP($J,"PR",INS,ICT,GPLAN,GCT,CAT,CCT)
. . . . . . . ; build/display data
. . . . . . . S DISPDATA=IDATA_U_GDATA_U_CDATA
. . . . . . . W !,DISPDATA
;
; REPORT Format
D HEADER(HDRNAME,HDRDATE)
;
; Nothing to print
I '$D(^TMP($J,"PR")) D G PRTEX
. W !,?40,NONEMSG ; No Data Found
; Process through the Print array
N FGP,FGCT,FINS,FICT
S INS=0 F S INS=$O(^TMP($J,"PR",INS)) Q:INS="" D I STOP G PRTEX
. S FINS=$O(^TMP($J,"PR","")),FICT=$O(^TMP($J,"PR",FINS,""))
. S ICT=0 F S ICT=$O(^TMP($J,"PR",INS,ICT)) Q:ICT="" D I STOP G PRTEX
. . K INSDATA,GPDATA,COVDATA
. . ; Blank line in between ins companies if it's not the first ins company
. . I INS'=FINS!(ICT'=FICT) D LINE(SPACES)
. . D INSDATA,LINE(INSDATA) I (IBPXT!$G(ZTSTOP)) S STOP=1 Q ; build/display data
. . S GPLAN=0 F S GPLAN=$O(^TMP($J,"PR",INS,ICT,GPLAN)) Q:GPLAN="" D I STOP G PRTEX
. . . S FGP=$O(^TMP($J,"PR",INS,ICT,"")),FGCT=$O(^TMP($J,"PR",INS,ICT,FGP,""))
. . . S GCT=0 F S GCT=$O(^TMP($J,"PR",INS,ICT,GPLAN,GCT)) Q:GCT="" D I STOP G PRTEX
. . . . ; Blank line in between group plans if it's not the first group plan
. . . . I GPLAN'=FGP!(GCT'=FGCT) D LINE(SPACES)
. . . . D GPDATA,LINE(GPDATA) I (IBPXT!$G(ZTSTOP)) S STOP=1 Q ; build/display data
. . . . S CAT=0 F S CAT=$O(^TMP($J,"PR",INS,ICT,GPLAN,GCT,CAT)) Q:CAT="" D I STOP G PRTEX
. . . . . S CCT=0 F S CCT=$O(^TMP($J,"PR",INS,ICT,GPLAN,GCT,CAT,CCT)) Q:CCT="" D I STOP G PRTEX
. . . . . . D COVDATA,LINE(COVDATA) I (IBPXT!$G(ZTSTOP)) S STOP=1 Q ; build/display data
;
PRTEX ;
I IBPXT!$G(ZTSTOP) Q
I IBCNGP("IBOUT")="E" W !,EORMSG
I IBCNGP("IBOUT")="R" D Q:(IBPXT!$G(ZTSTOP))
. I $Y+1>MAXCNT!('IBPGC) D HEADER(HDRNAME,HDRDATE)
. W !!,?40,EORMSG
Q
;
N DIR,DTOUT,DUOUT,LIN,OFFSET,X,Y
I IBPGC>0,$E(IOST,1,2)["C-" D Q:(IBPXT!$G(ZTSTOP))
. I MAXCNT<51 F LIN=1:1:(MAXCNT-$Y) W !
. S DIR(0)="E" D ^DIR K DIR
. I $D(DTOUT)!($D(DUOUT)) S IBPXT=1 Q
I $E(IOST,1,2)'["C-",$$S^%ZTLOAD() S ZTSTOP=1 Q
S IBPGC=IBPGC+1 I IBPGC>1!($E(IOST,1,2)["C-") W @IOF
W HDRNAME
S HDRDATE=HDRDATE_" Page: "_+IBPGC,OFFSET=(132-($L(HDRDATE)+1))
W ?OFFSET,HDRDATE,!
W DASHES
; Excel and Report Page 1 Header only
I IBCNGP("IBOUT")="E"!(IBPGC=1) D HDR1
I IBCNGP("IBOUT")="R" D HDR2
Q
;
EHDR ; EXCEL header
N HDR,HDR2
S HDR="COVERAGE LIMITATION REPORT"_U_HDRDATE
W HDR
D HDR1
S HDR2="INS COMPANY NAME^ADDRESS STREET^CITY^STATE^ZIP"
S HDR2=HDR2_"^GROUP NAME^GROUP NUMBER^TYPE OF PLAN"
S HDR2=HDR2_"^CATEGORY^EFFECTIVE DATE^COVERED?^LIMIT COMMENTS?"
W HDR2
Q
;
HDR1 ; Report Header for Page 1 and Excel report
W !,"+ =>INDIV. PLAN * => INACTIVE"
W !,"Filters: ",$S(IBCNGP("IBI")=1:"All",1:"Selected")," Insurances"
W ", ",$S(IBCNGP("IBIP")=1:"All",1:"Selected")," Group Plans"
W ", ",$S(+IBCNGP("IBFIL")=2:"Contains = ",+IBCNGP("IBFIL")=3:"Range = ",+IBCNGP("IBFIL")=4:"BLANK",1:"Begins with = ")
W $S(+IBCNGP("IBFIL")=3:$P(IBCNGP("IBFIL"),U,2)_"-"_$P(IBCNGP("IBFIL"),U,3),1:$P(IBCNGP("IBFIL"),U,2))
W ", "
I IBCNGP("IBICS")=5 W "All Coverage Statuses"
I IBCNGP("IBICS")'=5 D
. W "Coverage Status: "
. W $S(IBCNGP("IBICS")=1:"COVERED",IBCNGP("IBICS")=2:"NOT COVERED",IBCNGP("IBICS")=3:"CONDITIONAL",1:"BY DEFAULT")
W !
Q
;
HDR2 ; Column Headers for the Report format, for all pages
W !,"COMPANY",?15,"GROUP NAME",?38,"GROUP NUMBER",?58,"CATEGORY",?86,"EFFECTIVE DATE"
W ?103,"COVERED?",?116,"LIMIT COMMENTS?"
; At the beginning of a new page, redisplayed the Insurance Company. Don't display
; the Group Plan if you're starting a new group on the new page
I IBPGC>1,GPLAN'="" D LINE(INSDATA) I $G(CCT)'="" D LINE(GPDATA)
Q
;
INSDATA ; Insurance Company info
S IDATA=^TMP($J,"PR",INS,ICT)
S INSDATA=$$FO^IBCNEUT1($P(IDATA,U,1),"40T","L")_$E(SPACES,1,2)
S INSDATA=INSDATA_$P(IDATA,U,2)_", "_$P(IDATA,U,3)_", "
S INSDATA=INSDATA_$P(IDATA,U,4)_" "_$P(IDATA,U,5)
S IDATALN=1,GDATALN=0 ;702/DTG line spacing
Q
;
GPDATA ; Group Plan info
S GDATA=^TMP($J,"PR",INS,ICT,GPLAN,GCT)
S GPDATA=$E(SPACES,1,15)_$$FO^IBCNEUT1($P(GDATA,U,1),21,"L")_$E(SPACES,1,2)
S GPDATA=GPDATA_$$FO^IBCNEUT1($P(GDATA,U,2),18,"L")_$E(SPACES,1,2)
S GPDATA=GPDATA_"<< "_$P(GDATA,U,3)_" >>"
S GDATALN=1 ;702/DTG line spacing
Q
;
COVDATA ; Coverage info
S CDATA=^TMP($J,"PR",INS,ICT,GPLAN,GCT,CAT,CCT)
S COVDATA=$E(SPACES,1,58)_$$FO^IBCNEUT1($P(CDATA,U,1),"26T","L")_$E(SPACES,1,2)
S COVDATA=COVDATA_$$FO^IBCNEUT1($P(CDATA,U,2),15,"L")_$E(SPACES,1,2)
S COVDATA=COVDATA_$$FO^IBCNEUT1($P(CDATA,U,3),"11T","L")_$E(SPACES,1,2)
S COVDATA=COVDATA_$$FO^IBCNEUT1($P(CDATA,U,4),5,"L")
Q
;
LINE(DISPDATA) ; Print data
N NWPG
S NWPG=0
I $TR(DISPDATA," ","")="" G LINEX
I IBCNGP("IBOUT")="R" D Q:(IBPXT!$G(ZTSTOP))
. ; 702/DTG start line spacing
. I IDATALN=1 S IDATALN=0 I ($Y+4)>MAXCNT D HEADER(HDRNAME,HDRDATE) S NWPG=1 Q
. I GDATALN=1 S GDATALN=0 I ($Y+3)>MAXCNT D HEADER(HDRNAME,HDRDATE) S NWPG=1 Q
. ; 702/DTG end line spacing
. I ($Y+2)>MAXCNT!('IBPGC) D HEADER(HDRNAME,HDRDATE) S NWPG=1 I (IBPXT!$G(ZTSTOP)) Q
LINEX ;
S IDATALN=0
W !,DISPDATA
Q
;
CENTER(LINE,XWIDTH) ;return centered line OFFSET
N LENGTH,OFFSET
S LENGTH=$L(LINE),OFFSET=XWIDTH-$L(LINE)\2
Q OFFSET
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNGP1 15001 printed Apr 09, 2024@21:31:54 Page 2
IBCNGP1 ;ALB/CKB - REPORT OF COVERAGE LIMITATIONS (COMPILE/PRINT) ; 07-OCT-2021
+1 ;;2.0;INTEGRATED BILLING;**702**;21-MAR-94;Build 53
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
COMPILE(IBCNGPRTN,IBCNGP) ; Entry Point called from EN^XUTMDEVQ.
+1 ; IBCNGPRTN = Routine name for ^TMP($J,...
+2 ; IBCNGP = Array of params
+3 ; Input:
+4 ; IBCNGP("IBI") 0-Selected, 1-All Insurance Companies
+5 ; IBCNGP("IBIA") 0-Active, 1-Both Active and Inactive, 2-Inactive Insurance Companies
+6 ; IBCNGP("IBIP") 0-Selected, 1-All Group Plans
+7 ; IBCNGP("IBIPA") 0-Active, 1-Both Active and Inactive, 2-Inactive Group Plans
+8 ; IBCNGP("IBIGN") 1-Group Name, 2-Group Number, 3-Both Group Name and Group Number
+9 ; IBCNGP("IBFIL") A^B^C where"
+10 ; A - 1-Begin with, 2-Contains, 3-Range
+11 ; B - A=1 Begin with text, A=2 Contains text, A=3 Range start text
+12 ; C - only if A=3 Range End text
+13 ; IBCNGP("IBICS") 1-Covered, 2-Not Covered, 3-Conditional
+14 ; 4-By Default (blank status), 5-All Coverage Statuses
+15 ; IBCNGP("IBOUT") E-EXCEL, R-REPORT
+16 ;
+17 ; ^TMP("IBCNGP",$J,"INS",ICT)=IEN of the selected Insurance Company, file 36
+18 ; ICT - count of Insurance Companies
+19 ; ^TMP("IBCNGP",$J,"INS",ICT,"GRP",GCT)=IEN of the selected Group Plan, file 355.3
+20 ; GCT - count of Group Plans
+21 ;
+22 ; Compile and Print Report
+23 NEW GDATA,GCT,GIEN,IBCT,IBPGN,ICT,IIEN,PLANOK
+24 KILL ^TMP($JOB,"PR")
+25 ;
+26 IF $GET(IOST)["C-"
IF IBCNGP("IBOUT")="R"
WRITE !,"Compiling report data ...",!
+27 ;
+28 ;If ALL Group Plans, add groups to ^TMP("IBCNGP")
+29 IF IBCNGP("IBIP")
Begin DoDot:1
+30 SET IBCT=""
+31 FOR
SET IBCT=$ORDER(^TMP("IBCNGP",$JOB,"INS",IBCT))
if IBCT=""
QUIT
Begin DoDot:2
+32 SET IIEN=^TMP("IBCNGP",$JOB,"INS",IBCT)
+33 IF $DATA(^IBA(355.3,"B",IIEN))
Begin DoDot:3
+34 SET GCT=0
+35 SET GIEN=0
FOR
SET GIEN=$ORDER(^IBA(355.3,"B",IIEN,GIEN))
if 'GIEN
QUIT
Begin DoDot:4
+36 ; checks to see if Group Plan should be included on the report
+37 KILL GDATA
+38 DO GETS^DIQ(355.3,GIEN_",",".05;.06;.07;.08;.09;.11;2.01;2.02","EI","GDATA")
+39 SET PLANOK=$$PLANOK^IBCNSU21(.GDATA,IBCNGP("IBIPA"),IBCNGP("IBIGN"),IBCNGP("IBFIL"))
+40 IF 'PLANOK
QUIT
+41 SET GCT=GCT+1
+42 SET ^TMP("IBCNGP",$JOB,"INS",IBCT,"GRP",GCT)=GIEN
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+43 ;
+44 SET ICT=0
+45 FOR
SET ICT=$ORDER(^TMP("IBCNGP",$JOB,"INS",ICT))
if 'ICT
QUIT
Begin DoDot:1
+46 SET IIEN=^TMP("IBCNGP",$JOB,"INS",ICT)
+47 SET GCT=0
+48 FOR
SET GCT=$ORDER(^TMP("IBCNGP",$JOB,"INS",ICT,"GRP",GCT))
if 'GCT
QUIT
Begin DoDot:2
+49 SET GIEN=^TMP("IBCNGP",$JOB,"INS",ICT,"GRP",GCT)
+50 DO GETDATA
End DoDot:2
End DoDot:1
+51 ;
+52 DO PRINT
+53 ;
+54 KILL ^TMP("IBCNGP",$JOB)
+55 QUIT
+56 ;
GETDATA ; Get Insurance Company and Group Plan data
+1 ; Input: IIEN - IEN of the Insurance Company, file 36
+2 ; GIEN - IEN of the Group Plan, file 355.3
+3 ; Output: ^TMP($J,"PR",INSNAME,ICT,GNAME,GCT,IBCAT,CCT)) - C1^C2^..^C4 Where:
+4 ; INSNAME - Insurance Company name
+5 ; ICT - Insurance Company counter from ^TMP("IBCNGP")
+6 ; GNAME - Group Plan name
+7 ; GCT - Group Plans counter from ^TMP("IBCNGP")
+8 ; IBCAT - Coverage Category
+9 ; CCT - Coverage Category counter
+10 ; C1=Coverage Category, C2=Effective Date
+11 ; C3=Coverage Status, C4=Limitation Comment
+12 ;
+13 NEW CATARR,CCT,CDATA,CTR,GINACT,GIND,GNAME,GNUM,GTYP,I,IBCAT,IBCOV,IBCSTA,IBDT,IBEFDT,IBINS
+14 NEW IBLIMCOM,IBRECDT,IBRECN,INSNAME,PRINT,STATE,STATECD,XX
+15 ;
+16 ; NOTE: If a category has at least one instance where the Coverage matches the Coverage
+17 ; selected by the user, all instances for that Category will be displayed on the report.
+18 ;
+19 ; Compile Plans Coverage Limitation info
+20 ; File# 355.31 PLAN LIMITATION CATEGORY contains ALL coverage categories
+21 FOR I=1:1:$ORDER(^IBE(355.31,"B"),-1)
SET IBCAT=I
Begin DoDot:1
+22 ; If the Category doesn't exist for the Plan the Coverage Status is BY DEFAULT
+23 IF '$DATA(^IBA(355.32,"APCD",GIEN,I))
Begin DoDot:2
+24 ; Coverage Status
SET IBCSTA="BY DEFAULT"
+25 ; Coverage Category
SET IBCOV=$$GET1^DIQ(355.31,I,.01,"E")
+26 SET CATARR(IBCAT,0,0)=IBCOV_U_U_IBCSTA
+27 DO COVOK
End DoDot:2
QUIT
+28 SET IBRECDT=""
+29 FOR
SET IBRECDT=$ORDER(^IBA(355.32,"APCD",GIEN,IBCAT,IBRECDT))
if IBRECDT=""
QUIT
Begin DoDot:2
+30 SET IBRECN=""
+31 FOR
SET IBRECN=$ORDER(^IBA(355.32,"APCD",GIEN,IBCAT,IBRECDT,IBRECN))
if IBRECN=""
QUIT
Begin DoDot:3
+32 ; Coverage Category
SET IBCOV=$$GET1^DIQ(355.32,IBRECN,.02)
+33 ; Effective Date
SET IBEFDT=$$DAT3^IBOUTL($$GET1^DIQ(355.32,IBRECN,.03,"I"))
+34 ; Coverage Status
SET IBCSTA=$$GET1^DIQ(355.32,IBRECN,.04,"I")
+35 SET IBCSTA=$SELECT(IBCSTA="":"BY DEFAULT",IBCSTA=0:"NO",IBCSTA=1:"YES",1:"CONDITIONAL")
+36 SET IBLIMCOM=""
+37 ; Limit Comments?
IF $ORDER(^IBA(355.32,IBRECN,2,0))'=""
SET IBLIMCOM="YES"
+38 ; Build local array by Category and Date
+39 SET CATARR(IBCAT,IBRECDT,IBRECN)=IBCOV_U_IBEFDT_U_IBCSTA_U_IBLIMCOM
+40 ; Check Coverage to see if it should be displayed
+41 DO COVOK
End DoDot:3
End DoDot:2
End DoDot:1
+42 ;
CATARR ; Loop thru CATARR, add the Categories that should be displayed to the Print array.
+1 SET IBCAT=0
FOR
SET IBCAT=$ORDER(CATARR(IBCAT))
if IBCAT=""
QUIT
Begin DoDot:1
+2 IF $GET(CATARR(IBCAT))'=1
QUIT
+3 SET CCT=0
+4 SET IBDT=""
FOR
SET IBDT=$ORDER(CATARR(IBCAT,IBDT))
if IBDT=""
QUIT
Begin DoDot:2
+5 SET CTR=""
FOR
SET CTR=$ORDER(CATARR(IBCAT,IBDT,CTR))
if CTR=""
QUIT
Begin DoDot:3
+6 SET CDATA=CATARR(IBCAT,IBDT,CTR)
+7 SET IBCOV=$PIECE(CDATA,U)
+8 SET IBEFDT=$PIECE(CDATA,U,2)
+9 SET IBCSTA=$PIECE(CDATA,U,3)
+10 SET IBLIMCOM=$PIECE(CDATA,U,4)
+11 SET CCT=CCT+1
+12 ; The Insurance & Group info only need to be added once (the first category)
+13 ; Build the Print array
+14 ; builds Insurance & Group Plan print array
IF CCT=1
DO GETINS
DO GETGRP
+15 SET ^TMP($JOB,"PR",INSNAME,ICT,GNAME,GCT,IBCAT,CCT)=IBCOV_U_IBEFDT_U_IBCSTA_U_IBLIMCOM
End DoDot:3
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
GETINS ; Get Insurance info
+1 SET INSNAME=$$GET1^DIQ(36,IIEN,.01)
+2 SET $PIECE(IBINS,U)=INSNAME
+3 SET $PIECE(IBINS,U,2)=$SELECT($$GET1^DIQ(36,IIEN,.111)'="":$$GET1^DIQ(36,IIEN,.111),1:"<STREET ADDR 1 MISSING>")
+4 SET $PIECE(IBINS,U,3)=$$GET1^DIQ(36,IIEN,.114)
+5 SET XX=$$GET1^DIQ(36,IIEN,.115)
IF XX'=""
SET STATECD=$ORDER(^DIC(5,"B",XX,""))
+6 SET $PIECE(IBINS,U,4)=$SELECT(XX'="":$PIECE($GET(^DIC(5,STATECD,0)),U,2),1:"<STATE MISSING>")
+7 SET $PIECE(IBINS,U,5)=$$GET1^DIQ(36,IIEN,.116)
+8 SET ^TMP($JOB,"PR",INSNAME,ICT)=IBINS
+9 QUIT
+10 ;
GETGRP ; Get Group Plan info
+1 SET GIND=$$GET1^DIQ(355.3,GIEN,.1,"I")
+2 SET GINACT=$$GET1^DIQ(355.3,GIEN,.11,"I")
+3 SET GNAME=$SELECT($$GET1^DIQ(355.3,GIEN,2.01)'="":$$GET1^DIQ(355.3,GIEN,2.01),1:"<NO GROUP NAME>")
+4 SET GNUM=$SELECT($$GET1^DIQ(355.3,GIEN,2.02)'="":$$GET1^DIQ(355.3,GIEN,2.02),1:"<NO GROUP NUMBER>")
+5 ; Add '+'=individual and/or '*'=inactive
+6 IF GIND'=""
SET GNAME="+"_GNAME
+7 IF GINACT
SET GNUM="*"_GNUM
+8 SET GTYP=$SELECT($$GET1^DIQ(355.3,GIEN,.09)'="":$$GET1^DIQ(355.3,GIEN,.09),1:"<NO TYPE OF PLAN>")
+9 SET ^TMP($JOB,"PR",INSNAME,ICT,GNAME,GCT)=GNAME_U_GNUM_U_GTYP
+10 QUIT
+11 ;
COVOK ; If the Coverage matches what the user selected, flag the Category and set PRINT=1.
+1 ; This Coverage, it's Insurance and Group, will be displayed on the report.
+2 ; IBCNGP("IBICS") - 1-Covered, 2-Not Covered, 3-Conditional
+3 ; 4-By Default (blank status), 5-All Coverage Statuses
+4 IF IBCNGP("IBICS")=5
SET CATARR(IBCAT)=1
SET PRINT=1
QUIT
+5 IF IBCNGP("IBICS")=1
IF IBCSTA="YES"
SET CATARR(IBCAT)=1
SET PRINT=1
+6 IF IBCNGP("IBICS")=2
IF IBCSTA="NO"
SET CATARR(IBCAT)=1
SET PRINT=1
+7 IF IBCNGP("IBICS")=3
IF IBCSTA="CONDITIONAL"
SET CATARR(IBCAT)=1
SET PRINT=1
+8 IF IBCNGP("IBICS")=4
IF IBCSTA="BY DEFAULT"
SET CATARR(IBCAT)=1
SET PRINT=1
+9 QUIT
+10 ;
+11 ;============================PRINT==================================
PRINT ;
+1 ; Input: ^TMP($J,"PR",INSNAME,ICT,GNAME,GCT,IBCAT,CCT)) - C1^C2^..^C4 Where:
+2 ; INSNAME - Insurance Company name
+3 ; ICT - Insurance Company counter from ^TMP("IBCNGP")
+4 ; GNAME - Group Plan name
+5 ; GCT - Group Plans counter from ^TMP("IBCNGP")
+6 ; IBCAT - Coverage Category
+7 ; CCT - Coverage Category counter
+8 ; C1=Coverage Category, C2=Effective Date
+9 ; C3=Coverage Status, C4=Limitation Comment
+10 ;
+11 NEW CRT,DASHES,EORMSG,FIRST,HDRDATE,HDRNAME,IBPGC,IBPXT,MAXCNT,NONEMSG,SPACES,STOP,ZTSTOP
+12 SET (STOP,ZSTOP)=0
+13 SET EORMSG="*** End of Report ***"
+14 SET NONEMSG="* * * N o D a t a F o u n d * * *"
+15 SET HDRNAME="COVERAGE LIMITATION REPORT"
+16 DO NOW^%DTC
+17 SET HDRDATE=$$DAT2^IBOUTL($EXTRACT(%,1,12))
+18 SET $PIECE(DASHES,"-",132)=""
+19 SET $PIECE(SPACES," ",130)=""
+20 SET (IBPXT,IBPGC)=0
+21 SET MAXCNT=IOSL-3
SET CRT=1
+22 IF 'IOST["C-"
SET MAXCNT=IOSL-6
SET CRT=0
+23 ;
+24 ; Print report
+25 DO PRT
if (IBPXT!$GET(ZTSTOP))
QUIT
+26 IF CRT
IF IBPGC>0
IF $EXTRACT(IOST,1,2)["C-"
Begin DoDot:1
+27 IF MAXCNT<51
FOR LIN=1:1:(MAXCNT-$Y)
WRITE !
+28 SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:1
+29 IF IBCNGP("IBOUT")="E"
IF CRT
IF $EXTRACT(IOST,1,2)["C-"
SET DIR(0)="E"
DO ^DIR
KILL DIR
EXIT ; PRINT exit
+1 KILL ^TMP($JOB,"PR")
+2 QUIT
+3 ;
PRT ; Print report
+1 NEW BLANK,CAT,CCT,CDATA,DISPDATA,GCT,GPLAN,GDATA,ICT,IDATA,INS
+2 ;702/DTG line spacing
NEW GDATALN,IDATALN
+3 ;
+4 ; EXCEL Format
+5 IF IBCNGP("IBOUT")="E"
Begin DoDot:1
+6 ; EXCEL Header
DO EHDR
+7 IF '$DATA(^TMP($JOB,"PR"))
Begin DoDot:2
+8 ; No Data Found
WRITE !,NONEMSG
End DoDot:2
GOTO PRTEX
+9 SET INS=0
FOR
SET INS=$ORDER(^TMP($JOB,"PR",INS))
if INS=""
QUIT
Begin DoDot:2
+10 SET ICT=0
FOR
SET ICT=$ORDER(^TMP($JOB,"PR",INS,ICT))
if ICT=""
QUIT
Begin DoDot:3
+11 SET IDATA=^TMP($JOB,"PR",INS,ICT)
+12 SET GPLAN=0
FOR
SET GPLAN=$ORDER(^TMP($JOB,"PR",INS,ICT,GPLAN))
if GPLAN=""
QUIT
Begin DoDot:4
+13 SET GCT=0
FOR
SET GCT=$ORDER(^TMP($JOB,"PR",INS,ICT,GPLAN,GCT))
if GCT=""
QUIT
Begin DoDot:5
+14 SET GDATA=^TMP($JOB,"PR",INS,ICT,GPLAN,GCT)
+15 SET CAT=0
FOR
SET CAT=$ORDER(^TMP($JOB,"PR",INS,ICT,GPLAN,GCT,CAT))
if CAT=""
QUIT
Begin DoDot:6
+16 SET CCT=0
FOR
SET CCT=$ORDER(^TMP($JOB,"PR",INS,ICT,GPLAN,GCT,CAT,CCT))
if CCT=""
QUIT
Begin DoDot:7
+17 ; Init dispdata
KILL DISPDATA
+18 SET CDATA=^TMP($JOB,"PR",INS,ICT,GPLAN,GCT,CAT,CCT)
+19 ; build/display data
+20 SET DISPDATA=IDATA_U_GDATA_U_CDATA
+21 WRITE !,DISPDATA
End DoDot:7
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
GOTO PRTEX
+22 ;
+23 ; REPORT Format
+24 DO HEADER(HDRNAME,HDRDATE)
+25 ;
+26 ; Nothing to print
+27 IF '$DATA(^TMP($JOB,"PR"))
Begin DoDot:1
+28 ; No Data Found
WRITE !,?40,NONEMSG
End DoDot:1
GOTO PRTEX
+29 ; Process through the Print array
+30 NEW FGP,FGCT,FINS,FICT
+31 SET INS=0
FOR
SET INS=$ORDER(^TMP($JOB,"PR",INS))
if INS=""
QUIT
Begin DoDot:1
+32 SET FINS=$ORDER(^TMP($JOB,"PR",""))
SET FICT=$ORDER(^TMP($JOB,"PR",FINS,""))
+33 SET ICT=0
FOR
SET ICT=$ORDER(^TMP($JOB,"PR",INS,ICT))
if ICT=""
QUIT
Begin DoDot:2
+34 KILL INSDATA,GPDATA,COVDATA
+35 ; Blank line in between ins companies if it's not the first ins company
+36 IF INS'=FINS!(ICT'=FICT)
DO LINE(SPACES)
+37 ; build/display data
DO INSDATA
DO LINE(INSDATA)
IF (IBPXT!$GET(ZTSTOP))
SET STOP=1
QUIT
+38 SET GPLAN=0
FOR
SET GPLAN=$ORDER(^TMP($JOB,"PR",INS,ICT,GPLAN))
if GPLAN=""
QUIT
Begin DoDot:3
+39 SET FGP=$ORDER(^TMP($JOB,"PR",INS,ICT,""))
SET FGCT=$ORDER(^TMP($JOB,"PR",INS,ICT,FGP,""))
+40 SET GCT=0
FOR
SET GCT=$ORDER(^TMP($JOB,"PR",INS,ICT,GPLAN,GCT))
if GCT=""
QUIT
Begin DoDot:4
+41 ; Blank line in between group plans if it's not the first group plan
+42 IF GPLAN'=FGP!(GCT'=FGCT)
DO LINE(SPACES)
+43 ; build/display data
DO GPDATA
DO LINE(GPDATA)
IF (IBPXT!$GET(ZTSTOP))
SET STOP=1
QUIT
+44 SET CAT=0
FOR
SET CAT=$ORDER(^TMP($JOB,"PR",INS,ICT,GPLAN,GCT,CAT))
if CAT=""
QUIT
Begin DoDot:5
+45 SET CCT=0
FOR
SET CCT=$ORDER(^TMP($JOB,"PR",INS,ICT,GPLAN,GCT,CAT,CCT))
if CCT=""
QUIT
Begin DoDot:6
+46 ; build/display data
DO COVDATA
DO LINE(COVDATA)
IF (IBPXT!$GET(ZTSTOP))
SET STOP=1
QUIT
End DoDot:6
IF STOP
GOTO PRTEX
End DoDot:5
IF STOP
GOTO PRTEX
End DoDot:4
IF STOP
GOTO PRTEX
End DoDot:3
IF STOP
GOTO PRTEX
End DoDot:2
IF STOP
GOTO PRTEX
End DoDot:1
IF STOP
GOTO PRTEX
+47 ;
PRTEX ;
+1 IF IBPXT!$GET(ZTSTOP)
QUIT
+2 IF IBCNGP("IBOUT")="E"
WRITE !,EORMSG
+3 IF IBCNGP("IBOUT")="R"
Begin DoDot:1
+4 IF $Y+1>MAXCNT!('IBPGC)
DO HEADER(HDRNAME,HDRDATE)
+5 WRITE !!,?40,EORMSG
End DoDot:1
if (IBPXT!$GET(ZTSTOP))
QUIT
+6 QUIT
+7 ;
+1 NEW DIR,DTOUT,DUOUT,LIN,OFFSET,X,Y
+2 IF IBPGC>0
IF $EXTRACT(IOST,1,2)["C-"
Begin DoDot:1
+3 IF MAXCNT<51
FOR LIN=1:1:(MAXCNT-$Y)
WRITE !
+4 SET DIR(0)="E"
DO ^DIR
KILL DIR
+5 IF $DATA(DTOUT)!($DATA(DUOUT))
SET IBPXT=1
QUIT
End DoDot:1
if (IBPXT!$GET(ZTSTOP))
QUIT
+6 IF $EXTRACT(IOST,1,2)'["C-"
IF $$S^%ZTLOAD()
SET ZTSTOP=1
QUIT
+7 SET IBPGC=IBPGC+1
IF IBPGC>1!($EXTRACT(IOST,1,2)["C-")
WRITE @IOF
+8 WRITE HDRNAME
+9 SET HDRDATE=HDRDATE_" Page: "_+IBPGC
SET OFFSET=(132-($LENGTH(HDRDATE)+1))
+10 WRITE ?OFFSET,HDRDATE,!
+11 WRITE DASHES
+12 ; Excel and Report Page 1 Header only
+13 IF IBCNGP("IBOUT")="E"!(IBPGC=1)
DO HDR1
+14 IF IBCNGP("IBOUT")="R"
DO HDR2
+15 QUIT
+16 ;
EHDR ; EXCEL header
+1 NEW HDR,HDR2
+2 SET HDR="COVERAGE LIMITATION REPORT"_U_HDRDATE
+3 WRITE HDR
+4 DO HDR1
+5 SET HDR2="INS COMPANY NAME^ADDRESS STREET^CITY^STATE^ZIP"
+6 SET HDR2=HDR2_"^GROUP NAME^GROUP NUMBER^TYPE OF PLAN"
+7 SET HDR2=HDR2_"^CATEGORY^EFFECTIVE DATE^COVERED?^LIMIT COMMENTS?"
+8 WRITE HDR2
+9 QUIT
+10 ;
HDR1 ; Report Header for Page 1 and Excel report
+1 WRITE !,"+ =>INDIV. PLAN * => INACTIVE"
+2 WRITE !,"Filters: ",$SELECT(IBCNGP("IBI")=1:"All",1:"Selected")," Insurances"
+3 WRITE ", ",$SELECT(IBCNGP("IBIP")=1:"All",1:"Selected")," Group Plans"
+4 WRITE ", ",$SELECT(+IBCNGP("IBFIL")=2:"Contains = ",+IBCNGP("IBFIL")=3:"Range = ",+IBCNGP("IBFIL")=4:"BLANK",1:"Begins with = ")
+5 WRITE $SELECT(+IBCNGP("IBFIL")=3:$PIECE(IBCNGP("IBFIL"),U,2)_"-"_$PIECE(IBCNGP("IBFIL"),U,3),1:$PIECE(IBCNGP("IBFIL"),U,2))
+6 WRITE ", "
+7 IF IBCNGP("IBICS")=5
WRITE "All Coverage Statuses"
+8 IF IBCNGP("IBICS")'=5
Begin DoDot:1
+9 WRITE "Coverage Status: "
+10 WRITE $SELECT(IBCNGP("IBICS")=1:"COVERED",IBCNGP("IBICS")=2:"NOT COVERED",IBCNGP("IBICS")=3:"CONDITIONAL",1:"BY DEFAULT")
End DoDot:1
+11 WRITE !
+12 QUIT
+13 ;
HDR2 ; Column Headers for the Report format, for all pages
+1 WRITE !,"COMPANY",?15,"GROUP NAME",?38,"GROUP NUMBER",?58,"CATEGORY",?86,"EFFECTIVE DATE"
+2 WRITE ?103,"COVERED?",?116,"LIMIT COMMENTS?"
+3 ; At the beginning of a new page, redisplayed the Insurance Company. Don't display
+4 ; the Group Plan if you're starting a new group on the new page
+5 IF IBPGC>1
IF GPLAN'=""
DO LINE(INSDATA)
IF $GET(CCT)'=""
DO LINE(GPDATA)
+6 QUIT
+7 ;
INSDATA ; Insurance Company info
+1 SET IDATA=^TMP($JOB,"PR",INS,ICT)
+2 SET INSDATA=$$FO^IBCNEUT1($PIECE(IDATA,U,1),"40T","L")_$EXTRACT(SPACES,1,2)
+3 SET INSDATA=INSDATA_$PIECE(IDATA,U,2)_", "_$PIECE(IDATA,U,3)_", "
+4 SET INSDATA=INSDATA_$PIECE(IDATA,U,4)_" "_$PIECE(IDATA,U,5)
+5 ;702/DTG line spacing
SET IDATALN=1
SET GDATALN=0
+6 QUIT
+7 ;
GPDATA ; Group Plan info
+1 SET GDATA=^TMP($JOB,"PR",INS,ICT,GPLAN,GCT)
+2 SET GPDATA=$EXTRACT(SPACES,1,15)_$$FO^IBCNEUT1($PIECE(GDATA,U,1),21,"L")_$EXTRACT(SPACES,1,2)
+3 SET GPDATA=GPDATA_$$FO^IBCNEUT1($PIECE(GDATA,U,2),18,"L")_$EXTRACT(SPACES,1,2)
+4 SET GPDATA=GPDATA_"<< "_$PIECE(GDATA,U,3)_" >>"
+5 ;702/DTG line spacing
SET GDATALN=1
+6 QUIT
+7 ;
COVDATA ; Coverage info
+1 SET CDATA=^TMP($JOB,"PR",INS,ICT,GPLAN,GCT,CAT,CCT)
+2 SET COVDATA=$EXTRACT(SPACES,1,58)_$$FO^IBCNEUT1($PIECE(CDATA,U,1),"26T","L")_$EXTRACT(SPACES,1,2)
+3 SET COVDATA=COVDATA_$$FO^IBCNEUT1($PIECE(CDATA,U,2),15,"L")_$EXTRACT(SPACES,1,2)
+4 SET COVDATA=COVDATA_$$FO^IBCNEUT1($PIECE(CDATA,U,3),"11T","L")_$EXTRACT(SPACES,1,2)
+5 SET COVDATA=COVDATA_$$FO^IBCNEUT1($PIECE(CDATA,U,4),5,"L")
+6 QUIT
+7 ;
LINE(DISPDATA) ; Print data
+1 NEW NWPG
+2 SET NWPG=0
+3 IF $TRANSLATE(DISPDATA," ","")=""
GOTO LINEX
+4 IF IBCNGP("IBOUT")="R"
Begin DoDot:1
+5 ; 702/DTG start line spacing
+6 IF IDATALN=1
SET IDATALN=0
IF ($Y+4)>MAXCNT
DO HEADER(HDRNAME,HDRDATE)
SET NWPG=1
QUIT
+7 IF GDATALN=1
SET GDATALN=0
IF ($Y+3)>MAXCNT
DO HEADER(HDRNAME,HDRDATE)
SET NWPG=1
QUIT
+8 ; 702/DTG end line spacing
+9 IF ($Y+2)>MAXCNT!('IBPGC)
DO HEADER(HDRNAME,HDRDATE)
SET NWPG=1
IF (IBPXT!$GET(ZTSTOP))
QUIT
End DoDot:1
if (IBPXT!$GET(ZTSTOP))
QUIT
LINEX ;
+1 SET IDATALN=0
+2 WRITE !,DISPDATA
+3 QUIT
+4 ;
CENTER(LINE,XWIDTH) ;return centered line OFFSET
+1 NEW LENGTH,OFFSET
+2 SET LENGTH=$LENGTH(LINE)
SET OFFSET=XWIDTH-$LENGTH(LINE)\2
+3 QUIT OFFSET
