- IBCOMA1 ;ALB/CMS/JNM - IDENTIFY ACTIVE POLICIES W/NO EFFECTIVE DATE (CON'T) ; 09-29-2015
- ;;2.0;INTEGRATED BILLING;**103,516,528,549,743,752**;21-MAR-94;Build 20
- ;;Per VA Directive 6402, this routine should not be modified.
- Q
- BEG ; Entry to run Active Policies w/no Effective Date Report
- ; Input variables:
- ; IBAIB - Required. How to sort
- ; 1= Patient Name Range 2= Terminal Digit Range
- ; IBSIN - Required. Include Active Policies with
- ; 1= Verification Date 2= No Verification Date 3= Both
- ;
- ; IBRF - Required. Name or Terminal Digit Range Start value
- ; IBRL - Required. Name or Terminal Digit Range Go to value
- ; IBBDT - Optional. Beginning Verification Date Range
- ; IBEDT - Optional. Ending Verification Date Range
- ; IBEXCEL - 1 = Excel Format
- ;
- ; IB*2*549 - New filter variables
- ; IBPTYPE - Living/Deceased/Both filter ;
- ; IBAPPTS - Last Appointment Date Range Start
- ; IBAPPTE - Last Appointment Date Range End
- ;
- N APPTDATA,CAPPT,CDOD,CGRP,CINS,CLVBY,CLVDAT,CSSN,DFN,IBC,IBC0,IBCDA
- N IBCDA0,IBCDA1,IBI,IBPAGE,IBQUIT,IBTD,IBTMP,IBX,IDX,LASTAPPT,LASTVER
- N LVDATE,MAXGRP,MAXINS,MAXPT,MAXRPT,MAXVERBY,VA,VADM,VAERR,X,Y
- N IBVANM S IBVANM="" ;IB*752/DTG - new variable for case insensitive
- ;
- ; Set starting max field sizes to length of header text
- F IDX=1:1:2 S MAXPT(IDX)=12,MAXINS(IDX)=13,MAXGRP(IDX)=9,MAXVERBY(IDX)=5
- K ^TMP("IBCOMA",$J)
- S IBPAGE=0,IBQUIT=0
- ;
- ; Set up filter data for the call to SDAPI^SDAMA301 for IB*2*549
- I IBAPPTS>0 S APPTDATA(1)=IBAPPTS_";"_IBAPPTE
- S APPTDATA("FLDS")=1 ; Return Appt Date/Time Data
- S APPTDATA("MAX")=-1 ; Return Last Appt
- K ^TMP($J,"SDAMA301")
- ;
- S IBC=0 F S IBC=$O(^DPT("AB",IBC)) Q:'IBC D
- . S IBC0=$G(^DIC(36,IBC,0))
- . ;
- . ; If company inactive quit
- . Q:$P(IBC0,U,1)=""
- . Q:$P(IBC0,U,5)=1
- . S DFN=0 F S DFN=$O(^DPT("AB",IBC,DFN)) Q:'DFN D
- . . K VA,VADM,VAERR
- . . D DEM^VADPT
- . . ;
- . . ; IB*2*549 If Pt. deceased and not showing deceased patients quit
- . . I IBPTYPE=1,($G(VADM(6))>0) Q
- . . ;
- . . ; IB*2*549 If Pt. not deceased and not showing living patients quit
- . . I IBPTYPE=2,($G(VADM(6))'>0) Q
- . . S VADM(1)=$P($G(VADM(1)),U,1)
- . . ;
- . . ; I Pt. name out of range quit
- . . Q:VADM(1)=""
- . . ;IB*752/DTG - case insensitive check inclusive
- . . S IBVANM=$$UP^XLFSTR(VADM(1))
- . . ;I IBAIB=1,VADM(1)]IBRL Q
- . . ;I IBAIB=1,IBRF]VADM(1) Q
- . . I IBAIB=1,$E(IBVANM,1,$L(IBRLU))]IBRLU Q
- . . I IBAIB=1,IBRFU]$E(IBVANM,1,$L(IBRFU)) Q
- . . ;
- . . ; I Terminal Digit out of range quit
- . . I IBAIB=2 S IBTD=$$TERMDG^IBCONS2(DFN) S:IBTD="" IBTD="000000000" I (+IBTD>IBRL)!(IBRF>+IBTD) Q
- . . ;
- . . ; Fix subscript error if terminal digit is null
- . . I IBAIB=2,IBTD="" S IBTD=" "
- . . ;
- . . ; IB*2*549 Filter on last appointment date using ICR# 4433
- . . S APPTDATA(4)=DFN
- . . I $$SDAPI^SDAMA301(.APPTDATA)>0 D
- . . . S LASTAPPT=@$Q(^TMP($J,"SDAMA301"))
- . . . K ^TMP($J,"SDAMA301")
- . . E S LASTAPPT=0 I IBAPPTS>0 Q ; Filtering on Appt Date but no date in range
- . . ;
- . . S IBCDA=0 F S IBCDA=$O(^DPT("AB",IBC,DFN,IBCDA)) Q:'IBCDA D
- . . . ;IB*2.0*516/TAZ - Retrieve data from HIPAA compliant fields.
- . . . ;S IBCDA0=$G(^DPT(DFN,.312,IBCDA,0)) ;516 - baa
- . . . S IBCDA0=$$ZND^IBCNS1(DFN,IBCDA) ;516 - baa
- . . . ;
- . . . ; I Effective Date populated quit
- . . . Q:$P(IBCDA0,U,8)
- . . . ;
- . . . ; I Expiration Date entered and expired quit
- . . . I $P(IBCDA0,U,4),$P(IBCDA0,U,4)'>DT Q
- . . . ;
- . . . ; Sorting by verification date or no date check
- . . . S IBCDA1=$G(^DPT(DFN,.312,IBCDA,1))
- . . . S LVDATE=+$P($P(IBCDA1,U,3),".",1)
- . . . I IBSIN=1,LVDATE=0 Q
- . . . I IBSIN=1,IBBDT>0,(LVDATE<IBBDT)!(LVDATE>IBEDT) Q
- . . . I IBSIN=2,LVDATE>0 Q
- . . . I IBSIN=3,LVDATE>0,IBBDT>0,(LVDATE<IBBDT)!(LVDATE>IBEDT) Q
- . . . ;
- . . . ; Set data line for global
- . . . ;S IBTMP(1)=PT NAME^SSN^DATE OF DEATH^LAST APPT DATE
- . . . ;S IBTMP(2)=INSURANCE NAME
- . . . ;S IBTMP(3)=VERIFICATION DATE^LAST VERIFIED BY^GROUP NUMBER
- . . . ;
- . . . S IBTMP(1)=VADM(1)_U_$E(VADM(2),6,9)_U_$$FMTE^XLFDT($P(VADM(6),U,1),"2ZD")
- . . . S IBTMP(1)=IBTMP(1)_U_$$FMTE^XLFDT(LASTAPPT,"2ZD")
- . . . S IBTMP(2)=$P(IBC0,U,1)
- . . . S LASTVER=$P(IBCDA1,U,4)
- . . . I LASTVER'="" S LASTVER=$P($G(^VA(200,LASTVER,0)),U)
- . . . S IBTMP(3)=$$FMTE^XLFDT(LVDATE,"2ZD")_U_LASTVER_U_$P(IBCDA0,U,3)
- . . . ;
- . . . ; Set variable IBI for Verified=1 or Non verified=2
- . . . S IBI=$S(+$P(IBCDA1,U,3):1,1:2)
- . . . I 'IBEXCEL D
- . . . . D SETMAX(VADM(1),.MAXPT,IBI),SETMAX($P(IBC0,U,1),.MAXINS,IBI)
- . . . . D SETMAX(LASTVER,.MAXVERBY,IBI),SETMAX($P(IBCDA0,U,3),.MAXGRP,IBI)
- . . . ;
- . . . ; Set Global array
- . . . S ^TMP("IBCOMA",$J,IBI,$S(IBAIB=2:+IBTD,1:VADM(1)),DFN)=IBTMP(1)
- . . . S ^TMP("IBCOMA",$J,IBI,$S(IBAIB=2:+IBTD,1:VADM(1)),DFN,IBC)=IBTMP(2)
- . . . S ^TMP("IBCOMA",$J,IBI,$S(IBAIB=2:+IBTD,1:VADM(1)),DFN,IBC,IBCDA)=IBTMP(3)
- I 'IBEXCEL D CALCCOLS
- I '$D(^TMP("IBCOMA",$J)) D G QUEQ
- . D HD(1)
- . W !!,"** NO RECORDS FOUND **"
- . D EOR,ASK^IBCOMC2 ; IB*752/DTG - print EOR then pause
- D WRT
- ;IB*752/DTG - end of report then pause
- ;W !!,"** END OF REPORT **",!
- I '$G(IBQUIT) D EOR,ASK^IBCOMC2
- ;
- QUEQ ; Exit clean-UP
- W !
- D ^%ZISC
- K IBAIB,IBAPPTE,IBAPPTS,IBEXCEL,IBPTYPE,IBRF,IBRL,IBSIN,IBTMP,VA,VADM,VAERR,^TMP("IBCOMA",$J)
- K IBVANM ;IB*752/DTG - variable for case insensitive
- Q
- ;
- ;IB*752/DTG - end of report
- EOR ; end of report
- ;
- W !!,"** END OF REPORT **",!
- Q
- ;
- HD(IBA) ; Write Heading
- ; Input: IBA - 1 - Header for non-verified policies
- ; 2 - Header for verified policies
- ; CAPPT(IBA) - Starting Column Position for the 'Last Apt' Column
- ; CDOD(IBA) - Starting Column Position for the 'DoD' Column
- ; CGRP(IBA) - Starting Column Position for the 'Group No.' Column
- ; CINS(IBA) - Starting Column Position for the 'Insurance Co.' Column
- ; CSSN(IBA) - Starting Column Position for the 'SSN' Column
- ; CLVDAT(IBA) - Starting Column Position for the 'Last VC' Column
- ; CLVBY(IBA) - Starting Column Position for the 'VC By' Column
- ; IBPAGE - Current Page Number
- ; MAXRPT(IBA) - Maximum number of characters in column header line
- ; Output: IBPAGE - Updated Page Number
- ;
- ; IB*2.0*549 changed include Appoint Date filtering and
- ; dynamic column width based on actual data sizes
- I IBEXCEL D I 1
- . I +IBPAGE>0 Q ;IB*752/DTG correct header
- . D PGHD(0)
- . W !,"Patient Name^SSN^Insurance Co.^Group No.^Last VC^VC By^Last Apt^DoD"
- ;IB*752/DTG remove excel else
- ;E D
- I 'IBEXCEL D
- . S IBPAGE=IBPAGE+1
- . D PGHD(IBPAGE)
- . W !!,"Patient Name",?CSSN(IBA),"SSN",?CINS(IBA),"Insurance Co.",?CGRP(IBA),"Group No."
- . I IBA=1 W ?CLVDAT(IBA),"Last VC",?CLVBY(IBA),"VC By"
- . W ?CAPPT(IBA),"Last Apt",?CDOD(IBA),"DoD"
- . W !
- . F IBX=1:1:MAXRPT(IBA) W "="
- Q
- ;
- PGHD(IBPAGE) ; Print Report Page Header
- ; Input: IBPAGE - Current Page Number, 0 if exporting to Excel
- ; IBAIB - 1 Sorting by Patient Name, 2 - Sorting by Terminal Digit
- ; IBAPPTE - Internal Appointment Date Range End
- ; 0 if no Appointment Date Range filter
- ; IBAPPTS - Internal Appointment Date Range Start
- ; 0 if no Appointment Date Range filter
- ; IBBDT - Internal Verification Start date for Verification filter
- ; Null if no Verification filter
- ; IBEDT - Internal Verification End date for Verification filter
- ; Null if no Verification filter
- ; IB*743/TAZ - Modified IBRF to note NULL starts with the beginning of the list.
- ; IBRF - "" - First Patient Name, otherwise start of range filter
- ; IBRL - End of range filter
- ;
- N IBHDT
- S IBHDT=$$FMTE^XLFDT($$NOW^XLFDT,"Z")
- W:IBPAGE @IOF
- W:'IBPAGE !!
- W "Active Policies with no Effective Date Report "
- ;IB*752/DTG correct header for excel
- I IBEXCEL D Q
- . W " Run On: ",IBHDT
- . W !,"Filtered by: " ;IB*752/DTG - change sort to filter
- . W " Range: "_$S(IBRF="":"FIRST",1:IBRF)_" to "_$S(IBRL="zzzzzz":"LAST",1:IBRL)
- . I IBBDT>0 D
- . . W !,"Include: Verification Date Range: "_$$FMTE^XLFDT(IBBDT,"Z")
- . . W " to "_$$FMTE^XLFDT(IBEDT,"Z")
- . I IBAPPTS>0 D
- . . W !,"Include: Last Appointment Date Range: "_$$FMTE^XLFDT(IBAPPTS,"Z")
- . . W " to "_$$FMTE^XLFDT(IBAPPTE,"Z")
- . W !,"Filter: "
- . W $S(IBPTYPE=1:"Living Patients",IBPTYPE=2:"Deceased Patients",1:"Both Living & Deceased Patients")
- . W ", "_$S(IBSIN=1:"Verified Policies",IBSIN=2:"Non-Verified Policies",1:"Both Verified & Non-Verified Policies")
- ;E D
- ;. W ?IOM-34,IBHDT,?IOM-10,"Page: ",IBPAGE
- W ?IOM-34,IBHDT,?IOM-10,"Page: ",IBPAGE
- ;I IBPAGE W !,?5,"Filtered by: " ;IB*752/DTG - change sort to filter
- W !,?5,"Filtered by: " ;IB*752/DTG - change sort to filter
- ;E W !,?6,"Contains: "
- W $S(IBAIB=1:"Patient Name",1:"Terminal Digit")
- ;IB*743/TAZ - Modified Check on IBRF.
- ;W " Range: "_$S(IBRF="A":"FIRST",1:IBRF)_" to "_$S(IBRL="zzzzzz":"LAST",1:IBRL)
- W " Range: "_$S(IBRF="":"FIRST",1:IBRF)_" to "_$S(IBRL="zzzzzz":"LAST",1:IBRL)
- I IBBDT>0 D
- . W !,?7,"Include: Verification Date Range: "_$$FMTE^XLFDT(IBBDT,"Z")
- . W " to "_$$FMTE^XLFDT(IBEDT,"Z")
- I IBAPPTS>0 D
- . W !,?7,"Include: Last Appointment Date Range: "_$$FMTE^XLFDT(IBAPPTS,"Z")
- . W " to "_$$FMTE^XLFDT(IBAPPTE,"Z")
- W !,?8,"Filter: "_$S(IBPTYPE=1:"Living Patients",IBPTYPE=2:"Deceased Patients",1:"Both Living & Deceased Patients")
- W ", "_$S(IBSIN=1:"Verified Policies",IBSIN=2:"Non-Verified Policies",1:"Both Verified & Non-Verified Policies")
- Q
- ;
- WRT ; Write data lines
- N IBA,IBCDA,IBDA,IBFIRST,IBDFN,IBINS,IBLS,IBNA,IBPOL,IBPT,X,Y
- S IBQUIT=0,IBFIRST=1,IBLS="" ;IB*752/DTG added in IBLS for track of IBA change
- S IBA=0 F S IBA=$O(^TMP("IBCOMA",$J,IBA)) Q:('IBA)!(IBQUIT=1) D
- . I IBPAGE D ASK^IBCOMC2 I IBQUIT=1 Q
- . ;IB*752/DTG change for proper excel header
- . ;I IBEXCEL,IBFIRST D
- . ;. D HD(IBA)
- . ;. S IBFIRST=0
- . I IBEXCEL D
- . . I IBFIRST D
- . . . D HD(IBA)
- . . . S IBFIRST=0
- . ;
- . I 'IBEXCEL D
- . . D HD(IBA)
- . . W !,$S(IBA=1:"Verified",1:"Non-Verified"),!
- . S IBNA="" F S IBNA=$O(^TMP("IBCOMA",$J,IBA,IBNA)) Q:(IBNA="")!(IBQUIT=1) D
- . . S IBDFN=0 F S IBDFN=$O(^TMP("IBCOMA",$J,IBA,IBNA,IBDFN)) Q:('IBDFN)!(IBQUIT=1) D
- . . . S IBPT=$G(^TMP("IBCOMA",$J,IBA,IBNA,IBDFN))
- . . . ;
- . . . I 'IBEXCEL,($Y+7)>IOSL D I IBQUIT=1 Q
- . . . . D ASK^IBCOMC2 I IBQUIT=1 Q
- . . . . D HD(IBA)
- . . . ;
- . . . S IBDA=0 F S IBDA=$O(^TMP("IBCOMA",$J,IBA,IBNA,IBDFN,IBDA)) Q:('IBDA)!(IBQUIT=1) D
- . . . . S IBINS=$G(^TMP("IBCOMA",$J,IBA,IBNA,IBDFN,IBDA))
- . . . . ;
- . . . . S IBCDA=0 F S IBCDA=$O(^TMP("IBCOMA",$J,IBA,IBNA,IBDFN,IBDA,IBCDA)) Q:('IBCDA)!(IBQUIT=1) D
- . . . . . S IBPOL=$G(^TMP("IBCOMA",$J,IBA,IBNA,IBDFN,IBDA,IBCDA))
- . . . . . ;IB*752/DTG correct if and else to if's
- . . . . . ;I IBEXCEL D I 1
- . . . . . I IBEXCEL D
- . . . . . . W !,$P(IBPT,U,1),U,$P(IBPT,U,2),U,$P(IBINS,U,1),U,$P(IBPOL,U,3),U
- . . . . . . I $P(IBPOL,U,1)'=0 W $P(IBPOL,U,1)
- . . . . . . W U_$P(IBPOL,U,2)_U
- . . . . . . W $P(IBPT,U,4),U,$P(IBPT,U,3)
- . . . . . ;E D
- . . . . . I 'IBEXCEL D
- . . . . . . W !,$E($P(IBPT,U,1),1,MAXPT(IBA)),?CSSN(IBA),$P(IBPT,U,2),?CINS(IBA)
- . . . . . . W $E($P(IBINS,U,1),1,MAXINS(IBA)),?CGRP(IBA),$E($P(IBPOL,U,3),1,MAXGRP(IBA))
- . . . . . . I IBA=1 W ?CLVDAT(IBA),$P(IBPOL,U,1),?CLVBY(IBA),$E($P(IBPOL,U,2),1,MAXVERBY(IBA))
- . . . . . . W ?CAPPT(IBA),$P(IBPT,U,4),?CDOD(IBA),$P(IBPT,U,3)
- Q
- ;
- SETMAX(NAME,MAX,IBI) ; Get max length of data
- ; Input: NAME - Data to get maximum length for
- ; MAX(IBI)- Current Max length array
- ; IBI - Verified or Non-Verified section of the array
- ; Output MAX(IBI)- Updated Max length array (potentially)
- N LEN
- S LEN=$L(NAME)
- I LEN>MAX(IBI) S MAX(IBI)=LEN
- Q
- ;
- CALCCOLS ; Truncates the patient and insurance name field lengths if the total
- ; field lengths will not fit on the report (132 columns)
- ; Input: MAXGRP(IBA) - Maximum width of the 'Group No' column for
- ; verified (IBA=1) and non-verified (IBA=2) policies
- ; MAXINS(IBA) - Current Maximum width of the 'Insurance Co' column for
- ; verified (IBA=1) and non-verified (IBA=2) policies
- ; MAXPT(IBA) - Current Maximum width of the 'Patient Name' column for
- ; verified (IBA=1) and non-verified (IBA=2) policies
- ; MAXVERBY(IBA) - Maximum width of the 'VC By' column for
- ; verified (IBA=1) policies
- ; Output: MAXINS(IBA) - Updated Maximum width of the 'Insurance Co' column for
- ; verified (IBA=1) and non-verified (IBA=2) policies
- ; MAXPT(IBA) - Updated Maximum width of the 'Patient Name' column for
- ; verified (IBA=1) and non-verified (IBA=2) policies
- N DIFF,DIFF2,DIFF3,IDX,MAX
- S MAX(1)=89 ; MAX=131 - SSN(4) - 3 Dates(24) - 14 (Spaces between columns)
- S MAX(2)=101 ; MAX=131 - SSN(4) - 2 Dates(16) - 10 (Spaces between columns)
- F IDX=1:1:2 D
- . S DIFF=MAX(IDX)-MAXPT(IDX)-MAXINS(IDX)-MAXGRP(IDX)
- . I IDX=1 S DIFF=DIFF-MAXVERBY(IDX)
- . I DIFF<0 D
- . . S DIFF2=(-DIFF)\2
- . . S DIFF3=(-DIFF)-DIFF2
- . . S MAXPT(IDX)=MAXPT(IDX)-DIFF2
- . . S MAXINS(IDX)=MAXINS(IDX)-DIFF3
- . D SETCOLS(IDX)
- Q
- ;
- SETCOLS(IDX) ; Sets the column positions based on maximum data sizes
- ; Input: IDX - 1 - Verified policies section of the report
- ; 2 - Non-Verified policies section of the report
- ; MAXGRP(IBA) - Maximum width of the 'Group No' column for
- ; verified (IBA=1) and non-verified (IBA=2) policies
- ; MAXINS(IBA) - Maximum width of the 'Insurance Co' column for
- ; verified (IBA=1) and non-verified (IBA=2) policies
- ; MAXPT(IBA) - Maximum width of the 'Patient Name' column for
- ; verified (IBA=1) and non-verified (IBA=2) policies
- ; MAXVERBY(IBA) - Maximum width of the 'VC By' column for
- ; verified (IBA=1) policies
- ; Output: CAPPT(IDX) - Starting Column position for the 'Last Apt'
- ; Column for Verified and Non-Verified policies
- ; CDOD(IDX) - Starting Column position for the 'DoD'
- ; Column for Verified and Non-Verified policies
- ; CGRP(IDX) - Starting Column position for the 'Group No'
- ; Column for Verified and Non-Verified policies
- ; CINS(IDX) - Starting Column position for the 'Insurance Co.'
- ; Column for Verified and Non-Verified policies
- ; CLVBY(IDX) - Starting Column position for the 'VC By'
- ; Column for Verified and Non-Verified policies
- ; CLVDAT(IDX) - Starting Column position for the 'Last VC'
- ; Column for Verified and Non-Verified policies
- ; CSSN(IDX) - Starting Column position for the 'SSN'
- ; Column for Verified and Non-Verified policies
- S CSSN(IDX)=MAXPT(IDX)+2
- S CINS(IDX)=CSSN(IDX)+6
- S CGRP(IDX)=CINS(IDX)+MAXINS(IDX)+2
- I IDX=1 D
- . S CLVDAT(IDX)=CGRP(IDX)+MAXGRP(IDX)+2
- . S CLVBY(IDX)=CLVDAT(IDX)+10
- . S CAPPT(IDX)=CLVBY(IDX)+MAXVERBY(IDX)+2
- E S CAPPT(IDX)=CGRP(IDX)+MAXGRP(IDX)+2
- S CDOD(IDX)=CAPPT(IDX)+10
- S MAXRPT(IDX)=CDOD(IDX)+8
- Q
- ;IBCOMA1
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCOMA1 15916 printed Jan 18, 2025@03:19:29 Page 2
- IBCOMA1 ;ALB/CMS/JNM - IDENTIFY ACTIVE POLICIES W/NO EFFECTIVE DATE (CON'T) ; 09-29-2015
- +1 ;;2.0;INTEGRATED BILLING;**103,516,528,549,743,752**;21-MAR-94;Build 20
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 QUIT
- BEG ; Entry to run Active Policies w/no Effective Date Report
- +1 ; Input variables:
- +2 ; IBAIB - Required. How to sort
- +3 ; 1= Patient Name Range 2= Terminal Digit Range
- +4 ; IBSIN - Required. Include Active Policies with
- +5 ; 1= Verification Date 2= No Verification Date 3= Both
- +6 ;
- +7 ; IBRF - Required. Name or Terminal Digit Range Start value
- +8 ; IBRL - Required. Name or Terminal Digit Range Go to value
- +9 ; IBBDT - Optional. Beginning Verification Date Range
- +10 ; IBEDT - Optional. Ending Verification Date Range
- +11 ; IBEXCEL - 1 = Excel Format
- +12 ;
- +13 ; IB*2*549 - New filter variables
- +14 ; IBPTYPE - Living/Deceased/Both filter ;
- +15 ; IBAPPTS - Last Appointment Date Range Start
- +16 ; IBAPPTE - Last Appointment Date Range End
- +17 ;
- +18 NEW APPTDATA,CAPPT,CDOD,CGRP,CINS,CLVBY,CLVDAT,CSSN,DFN,IBC,IBC0,IBCDA
- +19 NEW IBCDA0,IBCDA1,IBI,IBPAGE,IBQUIT,IBTD,IBTMP,IBX,IDX,LASTAPPT,LASTVER
- +20 NEW LVDATE,MAXGRP,MAXINS,MAXPT,MAXRPT,MAXVERBY,VA,VADM,VAERR,X,Y
- +21 ;IB*752/DTG - new variable for case insensitive
- NEW IBVANM
- SET IBVANM=""
- +22 ;
- +23 ; Set starting max field sizes to length of header text
- +24 FOR IDX=1:1:2
- SET MAXPT(IDX)=12
- SET MAXINS(IDX)=13
- SET MAXGRP(IDX)=9
- SET MAXVERBY(IDX)=5
- +25 KILL ^TMP("IBCOMA",$JOB)
- +26 SET IBPAGE=0
- SET IBQUIT=0
- +27 ;
- +28 ; Set up filter data for the call to SDAPI^SDAMA301 for IB*2*549
- +29 IF IBAPPTS>0
- SET APPTDATA(1)=IBAPPTS_";"_IBAPPTE
- +30 ; Return Appt Date/Time Data
- SET APPTDATA("FLDS")=1
- +31 ; Return Last Appt
- SET APPTDATA("MAX")=-1
- +32 KILL ^TMP($JOB,"SDAMA301")
- +33 ;
- +34 SET IBC=0
- FOR
- SET IBC=$ORDER(^DPT("AB",IBC))
- if 'IBC
- QUIT
- Begin DoDot:1
- +35 SET IBC0=$GET(^DIC(36,IBC,0))
- +36 ;
- +37 ; If company inactive quit
- +38 if $PIECE(IBC0,U,1)=""
- QUIT
- +39 if $PIECE(IBC0,U,5)=1
- QUIT
- +40 SET DFN=0
- FOR
- SET DFN=$ORDER(^DPT("AB",IBC,DFN))
- if 'DFN
- QUIT
- Begin DoDot:2
- +41 KILL VA,VADM,VAERR
- +42 DO DEM^VADPT
- +43 ;
- +44 ; IB*2*549 If Pt. deceased and not showing deceased patients quit
- +45 IF IBPTYPE=1
- IF ($GET(VADM(6))>0)
- QUIT
- +46 ;
- +47 ; IB*2*549 If Pt. not deceased and not showing living patients quit
- +48 IF IBPTYPE=2
- IF ($GET(VADM(6))'>0)
- QUIT
- +49 SET VADM(1)=$PIECE($GET(VADM(1)),U,1)
- +50 ;
- +51 ; I Pt. name out of range quit
- +52 if VADM(1)=""
- QUIT
- +53 ;IB*752/DTG - case insensitive check inclusive
- +54 SET IBVANM=$$UP^XLFSTR(VADM(1))
- +55 ;I IBAIB=1,VADM(1)]IBRL Q
- +56 ;I IBAIB=1,IBRF]VADM(1) Q
- +57 IF IBAIB=1
- IF $EXTRACT(IBVANM,1,$LENGTH(IBRLU))]IBRLU
- QUIT
- +58 IF IBAIB=1
- IF IBRFU]$EXTRACT(IBVANM,1,$LENGTH(IBRFU))
- QUIT
- +59 ;
- +60 ; I Terminal Digit out of range quit
- +61 IF IBAIB=2
- SET IBTD=$$TERMDG^IBCONS2(DFN)
- if IBTD=""
- SET IBTD="000000000"
- IF (+IBTD>IBRL)!(IBRF>+IBTD)
- QUIT
- +62 ;
- +63 ; Fix subscript error if terminal digit is null
- +64 IF IBAIB=2
- IF IBTD=""
- SET IBTD=" "
- +65 ;
- +66 ; IB*2*549 Filter on last appointment date using ICR# 4433
- +67 SET APPTDATA(4)=DFN
- +68 IF $$SDAPI^SDAMA301(.APPTDATA)>0
- Begin DoDot:3
- +69 SET LASTAPPT=@$QUERY(^TMP($JOB,"SDAMA301"))
- +70 KILL ^TMP($JOB,"SDAMA301")
- End DoDot:3
- +71 ; Filtering on Appt Date but no date in range
- IF '$TEST
- SET LASTAPPT=0
- IF IBAPPTS>0
- QUIT
- +72 ;
- +73 SET IBCDA=0
- FOR
- SET IBCDA=$ORDER(^DPT("AB",IBC,DFN,IBCDA))
- if 'IBCDA
- QUIT
- Begin DoDot:3
- +74 ;IB*2.0*516/TAZ - Retrieve data from HIPAA compliant fields.
- +75 ;S IBCDA0=$G(^DPT(DFN,.312,IBCDA,0)) ;516 - baa
- +76 ;516 - baa
- SET IBCDA0=$$ZND^IBCNS1(DFN,IBCDA)
- +77 ;
- +78 ; I Effective Date populated quit
- +79 if $PIECE(IBCDA0,U,8)
- QUIT
- +80 ;
- +81 ; I Expiration Date entered and expired quit
- +82 IF $PIECE(IBCDA0,U,4)
- IF $PIECE(IBCDA0,U,4)'>DT
- QUIT
- +83 ;
- +84 ; Sorting by verification date or no date check
- +85 SET IBCDA1=$GET(^DPT(DFN,.312,IBCDA,1))
- +86 SET LVDATE=+$PIECE($PIECE(IBCDA1,U,3),".",1)
- +87 IF IBSIN=1
- IF LVDATE=0
- QUIT
- +88 IF IBSIN=1
- IF IBBDT>0
- IF (LVDATE<IBBDT)!(LVDATE>IBEDT)
- QUIT
- +89 IF IBSIN=2
- IF LVDATE>0
- QUIT
- +90 IF IBSIN=3
- IF LVDATE>0
- IF IBBDT>0
- IF (LVDATE<IBBDT)!(LVDATE>IBEDT)
- QUIT
- +91 ;
- +92 ; Set data line for global
- +93 ;S IBTMP(1)=PT NAME^SSN^DATE OF DEATH^LAST APPT DATE
- +94 ;S IBTMP(2)=INSURANCE NAME
- +95 ;S IBTMP(3)=VERIFICATION DATE^LAST VERIFIED BY^GROUP NUMBER
- +96 ;
- +97 SET IBTMP(1)=VADM(1)_U_$EXTRACT(VADM(2),6,9)_U_$$FMTE^XLFDT($PIECE(VADM(6),U,1),"2ZD")
- +98 SET IBTMP(1)=IBTMP(1)_U_$$FMTE^XLFDT(LASTAPPT,"2ZD")
- +99 SET IBTMP(2)=$PIECE(IBC0,U,1)
- +100 SET LASTVER=$PIECE(IBCDA1,U,4)
- +101 IF LASTVER'=""
- SET LASTVER=$PIECE($GET(^VA(200,LASTVER,0)),U)
- +102 SET IBTMP(3)=$$FMTE^XLFDT(LVDATE,"2ZD")_U_LASTVER_U_$PIECE(IBCDA0,U,3)
- +103 ;
- +104 ; Set variable IBI for Verified=1 or Non verified=2
- +105 SET IBI=$SELECT(+$PIECE(IBCDA1,U,3):1,1:2)
- +106 IF 'IBEXCEL
- Begin DoDot:4
- +107 DO SETMAX(VADM(1),.MAXPT,IBI)
- DO SETMAX($PIECE(IBC0,U,1),.MAXINS,IBI)
- +108 DO SETMAX(LASTVER,.MAXVERBY,IBI)
- DO SETMAX($PIECE(IBCDA0,U,3),.MAXGRP,IBI)
- End DoDot:4
- +109 ;
- +110 ; Set Global array
- +111 SET ^TMP("IBCOMA",$JOB,IBI,$SELECT(IBAIB=2:+IBTD,1:VADM(1)),DFN)=IBTMP(1)
- +112 SET ^TMP("IBCOMA",$JOB,IBI,$SELECT(IBAIB=2:+IBTD,1:VADM(1)),DFN,IBC)=IBTMP(2)
- +113 SET ^TMP("IBCOMA",$JOB,IBI,$SELECT(IBAIB=2:+IBTD,1:VADM(1)),DFN,IBC,IBCDA)=IBTMP(3)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +114 IF 'IBEXCEL
- DO CALCCOLS
- +115 IF '$DATA(^TMP("IBCOMA",$JOB))
- Begin DoDot:1
- +116 DO HD(1)
- +117 WRITE !!,"** NO RECORDS FOUND **"
- +118 ; IB*752/DTG - print EOR then pause
- DO EOR
- DO ASK^IBCOMC2
- End DoDot:1
- GOTO QUEQ
- +119 DO WRT
- +120 ;IB*752/DTG - end of report then pause
- +121 ;W !!,"** END OF REPORT **",!
- +122 IF '$GET(IBQUIT)
- DO EOR
- DO ASK^IBCOMC2
- +123 ;
- QUEQ ; Exit clean-UP
- +1 WRITE !
- +2 DO ^%ZISC
- +3 KILL IBAIB,IBAPPTE,IBAPPTS,IBEXCEL,IBPTYPE,IBRF,IBRL,IBSIN,IBTMP,VA,VADM,VAERR,^TMP("IBCOMA",$JOB)
- +4 ;IB*752/DTG - variable for case insensitive
- KILL IBVANM
- +5 QUIT
- +6 ;
- +7 ;IB*752/DTG - end of report
- EOR ; end of report
- +1 ;
- +2 WRITE !!,"** END OF REPORT **",!
- +3 QUIT
- +4 ;
- HD(IBA) ; Write Heading
- +1 ; Input: IBA - 1 - Header for non-verified policies
- +2 ; 2 - Header for verified policies
- +3 ; CAPPT(IBA) - Starting Column Position for the 'Last Apt' Column
- +4 ; CDOD(IBA) - Starting Column Position for the 'DoD' Column
- +5 ; CGRP(IBA) - Starting Column Position for the 'Group No.' Column
- +6 ; CINS(IBA) - Starting Column Position for the 'Insurance Co.' Column
- +7 ; CSSN(IBA) - Starting Column Position for the 'SSN' Column
- +8 ; CLVDAT(IBA) - Starting Column Position for the 'Last VC' Column
- +9 ; CLVBY(IBA) - Starting Column Position for the 'VC By' Column
- +10 ; IBPAGE - Current Page Number
- +11 ; MAXRPT(IBA) - Maximum number of characters in column header line
- +12 ; Output: IBPAGE - Updated Page Number
- +13 ;
- +14 ; IB*2.0*549 changed include Appoint Date filtering and
- +15 ; dynamic column width based on actual data sizes
- +16 IF IBEXCEL
- Begin DoDot:1
- +17 ;IB*752/DTG correct header
- IF +IBPAGE>0
- QUIT
- +18 DO PGHD(0)
- +19 WRITE !,"Patient Name^SSN^Insurance Co.^Group No.^Last VC^VC By^Last Apt^DoD"
- End DoDot:1
- IF 1
- +20 ;IB*752/DTG remove excel else
- +21 ;E D
- +22 IF 'IBEXCEL
- Begin DoDot:1
- +23 SET IBPAGE=IBPAGE+1
- +24 DO PGHD(IBPAGE)
- +25 WRITE !!,"Patient Name",?CSSN(IBA),"SSN",?CINS(IBA),"Insurance Co.",?CGRP(IBA),"Group No."
- +26 IF IBA=1
- WRITE ?CLVDAT(IBA),"Last VC",?CLVBY(IBA),"VC By"
- +27 WRITE ?CAPPT(IBA),"Last Apt",?CDOD(IBA),"DoD"
- +28 WRITE !
- +29 FOR IBX=1:1:MAXRPT(IBA)
- WRITE "="
- End DoDot:1
- +30 QUIT
- +31 ;
- PGHD(IBPAGE) ; Print Report Page Header
- +1 ; Input: IBPAGE - Current Page Number, 0 if exporting to Excel
- +2 ; IBAIB - 1 Sorting by Patient Name, 2 - Sorting by Terminal Digit
- +3 ; IBAPPTE - Internal Appointment Date Range End
- +4 ; 0 if no Appointment Date Range filter
- +5 ; IBAPPTS - Internal Appointment Date Range Start
- +6 ; 0 if no Appointment Date Range filter
- +7 ; IBBDT - Internal Verification Start date for Verification filter
- +8 ; Null if no Verification filter
- +9 ; IBEDT - Internal Verification End date for Verification filter
- +10 ; Null if no Verification filter
- +11 ; IB*743/TAZ - Modified IBRF to note NULL starts with the beginning of the list.
- +12 ; IBRF - "" - First Patient Name, otherwise start of range filter
- +13 ; IBRL - End of range filter
- +14 ;
- +15 NEW IBHDT
- +16 SET IBHDT=$$FMTE^XLFDT($$NOW^XLFDT,"Z")
- +17 if IBPAGE
- WRITE @IOF
- +18 if 'IBPAGE
- WRITE !!
- +19 WRITE "Active Policies with no Effective Date Report "
- +20 ;IB*752/DTG correct header for excel
- +21 IF IBEXCEL
- Begin DoDot:1
- +22 WRITE " Run On: ",IBHDT
- +23 ;IB*752/DTG - change sort to filter
- WRITE !,"Filtered by: "
- +24 WRITE " Range: "_$SELECT(IBRF="":"FIRST",1:IBRF)_" to "_$SELECT(IBRL="zzzzzz":"LAST",1:IBRL)
- +25 IF IBBDT>0
- Begin DoDot:2
- +26 WRITE !,"Include: Verification Date Range: "_$$FMTE^XLFDT(IBBDT,"Z")
- +27 WRITE " to "_$$FMTE^XLFDT(IBEDT,"Z")
- End DoDot:2
- +28 IF IBAPPTS>0
- Begin DoDot:2
- +29 WRITE !,"Include: Last Appointment Date Range: "_$$FMTE^XLFDT(IBAPPTS,"Z")
- +30 WRITE " to "_$$FMTE^XLFDT(IBAPPTE,"Z")
- End DoDot:2
- +31 WRITE !,"Filter: "
- +32 WRITE $SELECT(IBPTYPE=1:"Living Patients",IBPTYPE=2:"Deceased Patients",1:"Both Living & Deceased Patients")
- +33 WRITE ", "_$SELECT(IBSIN=1:"Verified Policies",IBSIN=2:"Non-Verified Policies",1:"Both Verified & Non-Verified Policies")
- End DoDot:1
- QUIT
- +34 ;E D
- +35 ;. W ?IOM-34,IBHDT,?IOM-10,"Page: ",IBPAGE
- +36 WRITE ?IOM-34,IBHDT,?IOM-10,"Page: ",IBPAGE
- +37 ;I IBPAGE W !,?5,"Filtered by: " ;IB*752/DTG - change sort to filter
- +38 ;IB*752/DTG - change sort to filter
- WRITE !,?5,"Filtered by: "
- +39 ;E W !,?6,"Contains: "
- +40 WRITE $SELECT(IBAIB=1:"Patient Name",1:"Terminal Digit")
- +41 ;IB*743/TAZ - Modified Check on IBRF.
- +42 ;W " Range: "_$S(IBRF="A":"FIRST",1:IBRF)_" to "_$S(IBRL="zzzzzz":"LAST",1:IBRL)
- +43 WRITE " Range: "_$SELECT(IBRF="":"FIRST",1:IBRF)_" to "_$SELECT(IBRL="zzzzzz":"LAST",1:IBRL)
- +44 IF IBBDT>0
- Begin DoDot:1
- +45 WRITE !,?7,"Include: Verification Date Range: "_$$FMTE^XLFDT(IBBDT,"Z")
- +46 WRITE " to "_$$FMTE^XLFDT(IBEDT,"Z")
- End DoDot:1
- +47 IF IBAPPTS>0
- Begin DoDot:1
- +48 WRITE !,?7,"Include: Last Appointment Date Range: "_$$FMTE^XLFDT(IBAPPTS,"Z")
- +49 WRITE " to "_$$FMTE^XLFDT(IBAPPTE,"Z")
- End DoDot:1
- +50 WRITE !,?8,"Filter: "_$SELECT(IBPTYPE=1:"Living Patients",IBPTYPE=2:"Deceased Patients",1:"Both Living & Deceased Patients")
- +51 WRITE ", "_$SELECT(IBSIN=1:"Verified Policies",IBSIN=2:"Non-Verified Policies",1:"Both Verified & Non-Verified Policies")
- +52 QUIT
- +53 ;
- WRT ; Write data lines
- +1 NEW IBA,IBCDA,IBDA,IBFIRST,IBDFN,IBINS,IBLS,IBNA,IBPOL,IBPT,X,Y
- +2 ;IB*752/DTG added in IBLS for track of IBA change
- SET IBQUIT=0
- SET IBFIRST=1
- SET IBLS=""
- +3 SET IBA=0
- FOR
- SET IBA=$ORDER(^TMP("IBCOMA",$JOB,IBA))
- if ('IBA)!(IBQUIT=1)
- QUIT
- Begin DoDot:1
- +4 IF IBPAGE
- DO ASK^IBCOMC2
- IF IBQUIT=1
- QUIT
- +5 ;IB*752/DTG change for proper excel header
- +6 ;I IBEXCEL,IBFIRST D
- +7 ;. D HD(IBA)
- +8 ;. S IBFIRST=0
- +9 IF IBEXCEL
- Begin DoDot:2
- +10 IF IBFIRST
- Begin DoDot:3
- +11 DO HD(IBA)
- +12 SET IBFIRST=0
- End DoDot:3
- End DoDot:2
- +13 ;
- +14 IF 'IBEXCEL
- Begin DoDot:2
- +15 DO HD(IBA)
- +16 WRITE !,$SELECT(IBA=1:"Verified",1:"Non-Verified"),!
- End DoDot:2
- +17 SET IBNA=""
- FOR
- SET IBNA=$ORDER(^TMP("IBCOMA",$JOB,IBA,IBNA))
- if (IBNA="")!(IBQUIT=1)
- QUIT
- Begin DoDot:2
- +18 SET IBDFN=0
- FOR
- SET IBDFN=$ORDER(^TMP("IBCOMA",$JOB,IBA,IBNA,IBDFN))
- if ('IBDFN)!(IBQUIT=1)
- QUIT
- Begin DoDot:3
- +19 SET IBPT=$GET(^TMP("IBCOMA",$JOB,IBA,IBNA,IBDFN))
- +20 ;
- +21 IF 'IBEXCEL
- IF ($Y+7)>IOSL
- Begin DoDot:4
- +22 DO ASK^IBCOMC2
- IF IBQUIT=1
- QUIT
- +23 DO HD(IBA)
- End DoDot:4
- IF IBQUIT=1
- QUIT
- +24 ;
- +25 SET IBDA=0
- FOR
- SET IBDA=$ORDER(^TMP("IBCOMA",$JOB,IBA,IBNA,IBDFN,IBDA))
- if ('IBDA)!(IBQUIT=1)
- QUIT
- Begin DoDot:4
- +26 SET IBINS=$GET(^TMP("IBCOMA",$JOB,IBA,IBNA,IBDFN,IBDA))
- +27 ;
- +28 SET IBCDA=0
- FOR
- SET IBCDA=$ORDER(^TMP("IBCOMA",$JOB,IBA,IBNA,IBDFN,IBDA,IBCDA))
- if ('IBCDA)!(IBQUIT=1)
- QUIT
- Begin DoDot:5
- +29 SET IBPOL=$GET(^TMP("IBCOMA",$JOB,IBA,IBNA,IBDFN,IBDA,IBCDA))
- +30 ;IB*752/DTG correct if and else to if's
- +31 ;I IBEXCEL D I 1
- +32 IF IBEXCEL
- Begin DoDot:6
- +33 WRITE !,$PIECE(IBPT,U,1),U,$PIECE(IBPT,U,2),U,$PIECE(IBINS,U,1),U,$PIECE(IBPOL,U,3),U
- +34 IF $PIECE(IBPOL,U,1)'=0
- WRITE $PIECE(IBPOL,U,1)
- +35 WRITE U_$PIECE(IBPOL,U,2)_U
- +36 WRITE $PIECE(IBPT,U,4),U,$PIECE(IBPT,U,3)
- End DoDot:6
- +37 ;E D
- +38 IF 'IBEXCEL
- Begin DoDot:6
- +39 WRITE !,$EXTRACT($PIECE(IBPT,U,1),1,MAXPT(IBA)),?CSSN(IBA),$PIECE(IBPT,U,2),?CINS(IBA)
- +40 WRITE $EXTRACT($PIECE(IBINS,U,1),1,MAXINS(IBA)),?CGRP(IBA),$EXTRACT($PIECE(IBPOL,U,3),1,MAXGRP(IBA))
- +41 IF IBA=1
- WRITE ?CLVDAT(IBA),$PIECE(IBPOL,U,1),?CLVBY(IBA),$EXTRACT($PIECE(IBPOL,U,2),1,MAXVERBY(IBA))
- +42 WRITE ?CAPPT(IBA),$PIECE(IBPT,U,4),?CDOD(IBA),$PIECE(IBPT,U,3)
- End DoDot:6
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +43 QUIT
- +44 ;
- SETMAX(NAME,MAX,IBI) ; Get max length of data
- +1 ; Input: NAME - Data to get maximum length for
- +2 ; MAX(IBI)- Current Max length array
- +3 ; IBI - Verified or Non-Verified section of the array
- +4 ; Output MAX(IBI)- Updated Max length array (potentially)
- +5 NEW LEN
- +6 SET LEN=$LENGTH(NAME)
- +7 IF LEN>MAX(IBI)
- SET MAX(IBI)=LEN
- +8 QUIT
- +9 ;
- CALCCOLS ; Truncates the patient and insurance name field lengths if the total
- +1 ; field lengths will not fit on the report (132 columns)
- +2 ; Input: MAXGRP(IBA) - Maximum width of the 'Group No' column for
- +3 ; verified (IBA=1) and non-verified (IBA=2) policies
- +4 ; MAXINS(IBA) - Current Maximum width of the 'Insurance Co' column for
- +5 ; verified (IBA=1) and non-verified (IBA=2) policies
- +6 ; MAXPT(IBA) - Current Maximum width of the 'Patient Name' column for
- +7 ; verified (IBA=1) and non-verified (IBA=2) policies
- +8 ; MAXVERBY(IBA) - Maximum width of the 'VC By' column for
- +9 ; verified (IBA=1) policies
- +10 ; Output: MAXINS(IBA) - Updated Maximum width of the 'Insurance Co' column for
- +11 ; verified (IBA=1) and non-verified (IBA=2) policies
- +12 ; MAXPT(IBA) - Updated Maximum width of the 'Patient Name' column for
- +13 ; verified (IBA=1) and non-verified (IBA=2) policies
- +14 NEW DIFF,DIFF2,DIFF3,IDX,MAX
- +15 ; MAX=131 - SSN(4) - 3 Dates(24) - 14 (Spaces between columns)
- SET MAX(1)=89
- +16 ; MAX=131 - SSN(4) - 2 Dates(16) - 10 (Spaces between columns)
- SET MAX(2)=101
- +17 FOR IDX=1:1:2
- Begin DoDot:1
- +18 SET DIFF=MAX(IDX)-MAXPT(IDX)-MAXINS(IDX)-MAXGRP(IDX)
- +19 IF IDX=1
- SET DIFF=DIFF-MAXVERBY(IDX)
- +20 IF DIFF<0
- Begin DoDot:2
- +21 SET DIFF2=(-DIFF)\2
- +22 SET DIFF3=(-DIFF)-DIFF2
- +23 SET MAXPT(IDX)=MAXPT(IDX)-DIFF2
- +24 SET MAXINS(IDX)=MAXINS(IDX)-DIFF3
- End DoDot:2
- +25 DO SETCOLS(IDX)
- End DoDot:1
- +26 QUIT
- +27 ;
- SETCOLS(IDX) ; Sets the column positions based on maximum data sizes
- +1 ; Input: IDX - 1 - Verified policies section of the report
- +2 ; 2 - Non-Verified policies section of the report
- +3 ; MAXGRP(IBA) - Maximum width of the 'Group No' column for
- +4 ; verified (IBA=1) and non-verified (IBA=2) policies
- +5 ; MAXINS(IBA) - Maximum width of the 'Insurance Co' column for
- +6 ; verified (IBA=1) and non-verified (IBA=2) policies
- +7 ; MAXPT(IBA) - Maximum width of the 'Patient Name' column for
- +8 ; verified (IBA=1) and non-verified (IBA=2) policies
- +9 ; MAXVERBY(IBA) - Maximum width of the 'VC By' column for
- +10 ; verified (IBA=1) policies
- +11 ; Output: CAPPT(IDX) - Starting Column position for the 'Last Apt'
- +12 ; Column for Verified and Non-Verified policies
- +13 ; CDOD(IDX) - Starting Column position for the 'DoD'
- +14 ; Column for Verified and Non-Verified policies
- +15 ; CGRP(IDX) - Starting Column position for the 'Group No'
- +16 ; Column for Verified and Non-Verified policies
- +17 ; CINS(IDX) - Starting Column position for the 'Insurance Co.'
- +18 ; Column for Verified and Non-Verified policies
- +19 ; CLVBY(IDX) - Starting Column position for the 'VC By'
- +20 ; Column for Verified and Non-Verified policies
- +21 ; CLVDAT(IDX) - Starting Column position for the 'Last VC'
- +22 ; Column for Verified and Non-Verified policies
- +23 ; CSSN(IDX) - Starting Column position for the 'SSN'
- +24 ; Column for Verified and Non-Verified policies
- +25 SET CSSN(IDX)=MAXPT(IDX)+2
- +26 SET CINS(IDX)=CSSN(IDX)+6
- +27 SET CGRP(IDX)=CINS(IDX)+MAXINS(IDX)+2
- +28 IF IDX=1
- Begin DoDot:1
- +29 SET CLVDAT(IDX)=CGRP(IDX)+MAXGRP(IDX)+2
- +30 SET CLVBY(IDX)=CLVDAT(IDX)+10
- +31 SET CAPPT(IDX)=CLVBY(IDX)+MAXVERBY(IDX)+2
- End DoDot:1
- +32 IF '$TEST
- SET CAPPT(IDX)=CGRP(IDX)+MAXGRP(IDX)+2
- +33 SET CDOD(IDX)=CAPPT(IDX)+10
- +34 SET MAXRPT(IDX)=CDOD(IDX)+8
- +35 QUIT
- +36 ;IBCOMA1