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

IBCNOR4.m

Go to the documentation of this file. 
  1. IBCNOR4 ;AITC/DTG - IBCN DUP GROUP TO INS USAGE ;12/14/23
  1.  ;;2.0;INTEGRATED BILLING;**778**;21-MAR-94;Build 28
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1. EN ; entry point
  1.  ;
  1.  N DIR,IBAR,IBCK,IBCNT,IBI,IBID,IBOK,IBONE,IBOUT,IBSTOP,IBTYP,IBXSAV,POP,X,Y
  1.  K ^TMP("IBCNOR4",$J) S ^TMP("IBCNOR4",$J,0)=""
  1.  W:$G(IOF)'="" @IOF W:$G(IOF)="" !
  1.  W !,"This report can help identify potential duplicate group plans by group"
  1.  W !,"number in one or more insurance companies. Search through the entire"
  1.  W !,"database for duplicate groups or narrow down the search by a specific"
  1.  W !,"group number."
  1.  ; get group numbers
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1. ENTYP ; get type equal or contain or all
  1.  ;
  1.  W ! S IBTYP=""
  1.  K DIR S DIR(0)="S^1:ALL Duplicate Groups;2:Specific Group Number"
  1.  S DIR("A")="SELECT 1 or 2"
  1.  S DIR("?",1)="All Duplicate Groups will search the entire database and if exact"
  1.  S DIR("?",2)="duplicates are found (by group number), all duplicate group results"
  1.  S DIR("?",3)="from all insurance companies will display on the report."
  1.  S DIR("?",4)=" "
  1.  S DIR("?",5)="Specific Group Number requires the user to enter a specific group"
  1.  S DIR("?",6)="number and will return all results of the searched group from all"
  1.  S DIR("?",7)="insurance companies (regardless of number of instances)."
  1.  S DIR("?")="Enter '^' to quit, OR"
  1.  D ^DIR
  1.  I Y="" S Y=1
  1.  I $E(Y)=U!$D(DIROUT)!$D(DIRUT)!$D(DTOUT)!$D(DUOUT) S Y="^"
  1.  I $E(Y)=U G EXIT
  1.  S IBTYP=+Y I 'Y G EXIT
  1.  I IBTYP=1 G CON  ; if looking for all skip the group number question
  1.  ;
  1. ENRK ; come here if continue from ^ response
  1.  K ^TMP("IBCNOR4",$J) S ^TMP("IBCNOR4",$J,0)=""
  1. ENR ; ask question return point. 
  1.  W !
  1.  K DIR S DIR(0)="F^1:30"
  1.  S DIR("A")="Enter a Group Number"
  1.  S DIR("?")="Enter a specific Group/Plan Number or '^' to quit"
  1.  S IBOK=0
  1. ENAQ ;
  1.  D ^DIR
  1.  ;
  1.  I $E(Y,1)=" " S IBOK=0 D  I 'IBOK S Y="" W !,"This is a required response. Enter '^' to exit" G ENAQ
  1.  . F IBI=1:1:$L(Y) I $E(Y,IBI)'=" " S IBOK=1 Q
  1.  I $E(Y)=U!$D(DIROUT)!$D(DIRUT)!$D(DTOUT)!$D(DUOUT) S Y=U
  1.  D ISET
  1.  I $E(Y)=U G EXIT
  1.  G RE
  1.  ;
  1. CON ; continue if all
  1.  I IBTYP'=1 G RE
  1.  W !!!,"WARNING: You have selected to run this report for all duplicate groups."
  1.  W !,"In doing so, this report will take a long time to run.",!
  1.  K DIR,DIRUT,DIROUT,DTOUT,DUOUT
  1.  S DIR(0)="Y"
  1.  S DIR("A")="Do you want to continue"
  1.  S DIR("B")="NO"
  1.  S DIR("?",1)=" Enter YES to continue."
  1.  S DIR("?")=" Enter NO or '^' to exit."
  1.  D ^DIR K DIR
  1.  I 'Y G EXIT  ; do not wish to continue
  1.  ;
  1. RE ; report or excel
  1.  S IBSTOP=0 D OUT I IBSTOP G EXIT
  1.  ;
  1.  D DEVICE
  1.  ;
  1. EXIT ; quit point
  1.  ;
  1.  K ^TMP("IBCNOR4",$J)
  1.  Q
  1.  ;
  1.  ;
  1. ISET ; if item save and set flag
  1.  ;
  1.  N IBA,IBC,IBD,IBE,IBFND
  1.  I Y=""!($E(Y)=U) Q  ; leave IBOK 0 in order to stop
  1.  S ^TMP("IBCNOR4",$J,1,Y)=1,^TMP("IBCNOR4",$J,0)=1,^TMP("IBCNOR4",$J,"U",($$UP^XLFSTR(Y)))=1
  1.  Q
  1.  ;
  1. OUT ; Prompt to allow users to select output format
  1.  ; Returns: E - Output to excel
  1.  ;          R - Output to report
  1.  ;   IBSTOP=1 - No Selection made
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1.  W !
  1.  S DIR(0)="SA^E:Excel;R:Report"
  1.  S DIR("A")="(E)xcel Format or (R)eport Format: "
  1.  S DIR("B")="Report"
  1.  S DIR("?",1)="Select 'E' to create CSV output for import into Excel."
  1.  S DIR("?")="Select 'R' to create a standard report."
  1.  D ^DIR K DIR
  1.  I $D(DIROUT)!$D(DIRUT)!$D(DTOUT)!$D(DUOUT) S IBSTOP=1 G OUTQ
  1.  S IBOUT=Y
  1.  Q
  1. OUTQ ;
  1.  ;
  1.  Q
  1.  ;
  1. DEVICE ;
  1.  N IBB,POP,ZTDESC,ZTRTN,ZTSAVE
  1.  I IBOUT="R" W !!,"***This report is 132 characters wide.***",!
  1.  I IBOUT="E" D
  1.  . W !!,"For CSV output, turn logging or capture on now.",!
  1.  . W "To avoid undesired wrapping of the data, please"
  1.  . W !," enter '0;256;99999'.",!
  1.  K IBXSAV M IBXSAV=^TMP("IBCNOR4",$J)
  1.  S ZTRTN="COMPILE^IBCNOR4"
  1.  S ZTDESC="LD - LIST DUPLICATE GROUP PLANS BY INS CO"
  1.  F IBB="IBOUT","IBTYP","IBXSAV(" S ZTSAVE(IBB)=""
  1.  D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"Q")   ; ICR # 1519
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. COMPILE ; build output of payers
  1.  ;
  1.  N %,IB3553,IB36,IBA,IBADDR,IBARY,IBB,IBC,IBCTL,IBCHK,IBCNT,IBCRT,IBDASHES,IBDOT,IBEORMSG,IBFILTER
  1.  N IBGCT,IBGNAM,IBGON,IBHDR
  1.  N IBHDRDATE,IBHDRNAME,IBINDX,IBINS,IBITM,IBL,IBLOOK,IBLNC,IBLS,IBMAXCNT,IBNM,IBNONEMSG
  1.  N IBPGC,IBS,IBS3553,IBSPACES,IBST,IBSTAB,IBSTOP,IBSI,IBSTOP,IBUN,IBW,IBXTFEED,IBZIP
  1.  ;
  1.  S IBOUT=$G(IBOUT)
  1.  S IBCHK=0
  1.  S IBMAXCNT=IOSL-3,IBXTFEED=21,IBCRT=1,IBLNC=0
  1.  I IOST'["C-" S IBMAXCNT=IOSL-6,IBXTFEED=50,IBCRT=0
  1.  S IBEORMSG="*** End of Report ***"
  1.  S IBNONEMSG="* * * N o   D a t a   F o u n d * * *"
  1.  S IBHDRNAME="List Duplicate Group Plans by Insurance Company"
  1.  D NOW^%DTC
  1.  S IBHDRDATE=$$DAT2^IBOUTL($E(%,1,12))
  1.  S $P(IBDASHES,"-",132)=""
  1.  S $P(IBSPACES," ",80)=""
  1.  S IBHDR="HDR"_$S(IBOUT="E":"E",1:"R")
  1.  K ^TMP($J,"IBCNOR4")
  1.  K ^TMP($J,"IBCNOR4-1")
  1.  K IBFND
  1.  M ^TMP($J,"IBCNOR4")=IBXSAV
  1.  S IBDOT=2000 I IBTYP=1 S IBDOT=100000  ; reduce dots for subscribers when all are selected
  1.  ;
  1.  ;compile
  1.  ; walk the indexes
  1.  ;
  1.  I IBCRT W !,"Checking for Duplicate Group Number(s)",!
  1.  S IBFILTER="" I IBTYP=2 S IBFILTER="Selected: "
  1.  D RUN
  1.  ; if all collect all group numbers
  1.  I IBTYP=1 S IBFILTER="All Group Numbers"
  1.  I IBTYP=2 S IBLOOK="",IBCNT=0 F  S IBLOOK=$O(^TMP($J,"IBCNOR4",1,IBLOOK)) Q:IBLOOK=""  D
  1.  . S IBB=$G(^TMP($J,"IBCNOR4",1,IBLOOK)) I IBB=1 S IBFILTER=IBFILTER_($S('+IBCHK:"",1:", "))_IBLOOK S IBCHK=IBCHK+1
  1.  ;
  1.  D WALK ; get subscriber counts
  1.  ;
  1.  ; uses ^TMP($J,"IBCNOR4-1") to print
  1.  ;
  1. PRINT ; out put the compile in insurance co name order
  1.  ;
  1.  N IBA,IBGLIN
  1.  K IBW,IBARY
  1.  S IBSTOP=0,IBPGC=0,IBGCT=0,IBGON=""
  1.  I '+$G(^TMP($J,"IBCNOR4-1",2)) D NOD G EXITC
  1.  D:IBOUT="E" HDRE D:IBOUT="R" HDRR
  1.  I IBOUT="E" D
  1.  . S IBNM="" F  S IBNM=$O(^TMP($J,"IBCNOR4-1",6,IBNM)) Q:IBNM=""  D
  1.  .. S IBGLIN=$G(^TMP($J,"IBCNOR4-1",2,IBNM))
  1.  .. I IBTYP=1&(IBGLIN<2) Q  ; if doing all do not print group if only one insurance associated
  1.  .. S IBGNAM="" F  S IBGNAM=$O(^TMP($J,"IBCNOR4-1",6,IBNM,IBGNAM)) Q:IBGNAM=""  D
  1.  ... S IBINS="" F  S IBINS=$O(^TMP($J,"IBCNOR4-1",6,IBNM,IBGNAM,IBINS)) Q:IBINS=""  D
  1.  .... S IBADDR="" F  S IBADDR=$O(^TMP($J,"IBCNOR4-1",6,IBNM,IBGNAM,IBINS,IBADDR)) Q:IBADDR=""  D
  1.  ..... S IB3553="" F  S IB3553=$O(^TMP($J,"IBCNOR4-1",6,IBNM,IBGNAM,IBINS,IBADDR,IB3553)) Q:IB3553=""  D
  1.  ...... S IBA=$G(^TMP($J,"IBCNOR4-1",6,IBNM,IBGNAM,IBINS,IBADDR,IB3553))
  1.  ...... W !,$P(IBA,U,4),U,IBNM,U,IBGNAM,U,IBINS,U,IBADDR,U,$P(IBA,U,2),U,$P(IBA,U,3)
  1.  ;
  1.  I IBOUT="R" D
  1.  . S IBNM="" F  S IBNM=$O(^TMP($J,"IBCNOR4-1",1,IBNM)) Q:IBNM=""  D  Q:IBSTOP
  1.  .. S IBGLIN=$G(^TMP($J,"IBCNOR4-1",2,IBNM))
  1.  .. I IBTYP=1&(IBGLIN<2) Q  ; if doing all do not print group if only one insurance associated
  1.  .. ; make sure to print at least one INS for the group on same page
  1.  .. I IBLNC+2>IBMAXCNT D QLINE Q:IBSTOP  D:IBOUT="E" HDRE D:IBOUT="R" HDRR
  1.  .. W !,IBNM  S IBLNC=IBLNC+1,IBGCT=0  ; print group number first
  1.  .. S IBINS="" F  S IBINS=$O(^TMP($J,"IBCNOR4-1",1,IBNM,IBINS)) Q:IBINS=""  D  Q:IBSTOP
  1.  ... S IBADDR="" F  S IBADDR=$O(^TMP($J,"IBCNOR4-1",1,IBNM,IBINS,IBADDR)) Q:IBADDR=""  D  Q:IBSTOP
  1.  .... S IB3553="" F  S IB3553=$O(^TMP($J,"IBCNOR4-1",1,IBNM,IBINS,IBADDR,IB3553)) Q:IB3553=""  D  Q:IBSTOP
  1.  ..... S IBGCT=IBGCT+1,IBA=$G(^TMP($J,"IBCNOR4-1",1,IBNM,IBINS,IBADDR,IB3553))
  1.  ..... S IBW=$S(IBOUT="E":$P(IBA,U,5),1:$P(IBA,U,4))_U_$P(IBA,U,3)_U_$P(IBA,U,2)
  1.  ..... W !,?2,$P(IBA,U,6),?6,IBINS,?38,IBADDR,?74,$P(IBW,U,1),?83,$P(IBW,U,2),?107,$E($P(IBW,U,3),1,24)
  1.  ..... S IBLNC=IBLNC+1
  1.  ..... I (IBPGC>0),(IBLNC+1>IBMAXCNT) D
  1.  ...... D QLINE Q:IBSTOP
  1.  ...... D:IBOUT="E" HDRE D:IBOUT="R" HDRR
  1.  ...... I IBGCT<IBGLIN W !,IBNM,"   (continued)"
  1.  I IBSTOP G EXITC
  1.  W !,IBEORMSG
  1.  D QLINE
  1.  ;
  1.  ;
  1. EXITC ; compile section exit
  1.  ;
  1.  K ^TMP($J,"IBCNOR4-1")
  1.  K ^TMP($J,"IBCNOR4")
  1.  Q
  1.  ;
  1.  ;
  1. NOD ; no info to print
  1.  ;
  1.  D:IBOUT="E" HDRE D:IBOUT="R" HDRR
  1.  W !,IBNONEMSG,!,IBEORMSG
  1.  D QLINE
  1.  Q
  1.  ;
  1. QLINE ; cr to continue
  1.  ;
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,LIN
  1.  W !
  1.  I 'IBCRT Q
  1.  S DIR(0)="E" D ^DIR K DIR
  1.  I $D(DTOUT)!$D(DUOUT) S IBSTOP=1
  1.  Q
  1.  ;
  1.  ;
  1. WALK(IBINDX,IBLS) ; get subscribers
  1.  ;
  1.  N IB3553,IB36,IBA,IBARY,IBB,IBC,IBD,IBDTA,IBINAL1,IBINM,IBGNUM,IBSUBCT,IBPTDFN,IBPTINS
  1.  I IBCRT W !,"Gathering Subscriber Counts: ",!,"."
  1.  S IB36=0,IBCNT=0 F  S IB36=$O(^TMP($J,"IBCNOR4",5,IB36)) Q:'IB36  D
  1.  . ;check pt file #2.312
  1.  . S IBPTDFN=0 F  S IBPTDFN=$O(^DPT("AB",IB36,IBPTDFN)) Q:'IBPTDFN  S IBPTINS=0 D
  1.  .. F  S IBPTINS=$O(^DPT("AB",IB36,IBPTDFN,IBPTINS)) Q:'IBPTINS  D
  1.  ... S IBCNT=IBCNT+1 I IBCRT&(IBCNT#IBDOT=0) W "."
  1.  ... S IBA=$$GET1^DIQ(2.312,IBPTINS_","_IBPTDFN_",",.18,"I")
  1.  ... I 'IBA Q  ; no group associated
  1.  ... I '$D(^TMP($J,"IBCNOR4",5,IB36,IBA)) Q  ; ins/group combo not selected
  1.  ... S ^TMP($J,"IBCNOR4",5,IB36,IBA)=$G(^TMP($J,"IBCNOR4",5,IB36,IBA))+1
  1.  I IBCRT W !,"Placing Subscriber Totals: ",!,"."
  1.  ; ^TMP(39151,"IBCNOR4",4, group number , insurance co name , ins co address line 1 , 355.3 IEN) =
  1.  ;     file 36 IEN ^ type of plan ^ group name with + or * as needed ^ subscriber count ^ sub ct no spaces ^ ins A or I
  1.  S (IBCHK,IBCNT)=0,IBGNUM="" F  S IBGNUM=$O(^TMP($J,"IBCNOR4",4,IBGNUM)) Q:IBGNUM=""  S IBINM="" D
  1.  . F  S IBINM=$O(^TMP($J,"IBCNOR4",4,IBGNUM,IBINM)) Q:IBINM=""  S IBINAL1="" D
  1.  .. F  S IBINAL1=$O(^TMP($J,"IBCNOR4",4,IBGNUM,IBINM,IBINAL1)) Q:IBINAL1=""  S IB3553=0 D
  1.  ... F  S IB3553=$O(^TMP($J,"IBCNOR4",4,IBGNUM,IBINM,IBINAL1,IB3553)) Q:'IB3553  D
  1.  .... I IBCRT&(IBCNT#30000=0) W "."
  1.  .... S IBDTA=$G(^TMP($J,"IBCNOR4",4,IBGNUM,IBINM,IBINAL1,IB3553))
  1.  .... S IB36=$P(IBDTA,U,1)
  1.  .... ; place total subscribers for each item
  1.  .... S IBSUBCT=$G(^TMP($J,"IBCNOR4",5,IB36,IB3553)),IBCNT=IBCNT+1
  1.  .... ;
  1.  .... S IBB=$FN(IBSUBCT,",",0)
  1.  .... S IBC=$E(IBSPACES,1,(7-$L(IBB)))_IBB,$P(IBDTA,U,4)=IBC,$P(IBDTA,U,5)=IBB
  1.  .... S ^TMP($J,"IBCNOR4-1",1,IBGNUM,IBINM,IBINAL1,IB3553)=IBDTA
  1.  .... S ^TMP($J,"IBCNOR4-1",2,IBGNUM)=$G(^TMP($J,"IBCNOR4-1",2,IBGNUM))+1  ; how many lines for the group number
  1.  .... S ^TMP($J,"IBCNOR4-1",2)=$G(^TMP($J,"IBCNOR4-1",2))+1
  1.  .... ; this is for the excel output since it is different for the report output
  1.  .... ; ins AorI , gp num , gp nam , ins nm , ins add l1 , 355.33 ien = ins ien ^ typ pln ^ tot sums
  1.  .... S ^TMP($J,"IBCNOR4-1",6,IBGNUM,$P(IBDTA,U,3),IBINM,IBINAL1,IB3553)=$P(IBDTA,U,1)_U_$P(IBDTA,U,2)_U_$P(IBDTA,U,5)_U_$P(IBDTA,U,6)
  1.  ;
  1.  Q
  1.  ;
  1. RUN ; go through 355.3
  1.  ;
  1.  N IB3553GNA,IB3553TY,IB36A1,IB36N,IB5,IBAR5,IBINA
  1.  S IBS3553="",IBCNT=0,IBCTL=0 F  S IBS3553=$O(^IBA(355.3,IBS3553)) Q:IBS3553=""  D
  1.  . S IBCNT=IBCNT+1 I IBCRT&(IBCNT#4000=0) W "."
  1.  . S IB36=$$GET1^DIQ(355.3,IBS3553_",",.01,"I") I 'IB36 Q  ; if there is no insurance get next
  1.  . I '$D(^DIC(36,IB36,0)) Q  ; if the pointer is invalid go back
  1.  . ; (#.01) INSURANCE COMPANY [1P:36]
  1.  . ; (#.02) IS THIS A GROUP POLICY?  '1' FOR YES; '0' FOR NO
  1.  . ; (#.03) *GROUP NAME
  1.  . ; (#.04) *GROUP NUMBER
  1.  . ; (#.09) TYPE OF PLAN [9P:355.1]
  1.  . ; (#.11) INACTIVE '0' FOR NO; '1' FOR YES
  1.  . ; (#2.01) GROUP NAME
  1.  . ; (#2.02) GROUP NUMBER
  1.  . K IBAR5 D GETS^DIQ(355.3,IBS3553_",",".01;.02;.03;.04;.09;.11;2.01;2.02","IE","IBAR5")
  1.  . K IB5 M IB5=IBAR5(355.3,IBS3553_",")
  1.  . ; get group number
  1.  . S IBSI=$G(IB5(2.02,"I"))  ; get group number from 'approved' group number field
  1.  . I IBSI="" S IBSI=$G(IB5(.04,"I"))  ; get group number from 'old' field if 'approved' is null
  1.  . I IBSI="" Q  ; no group number go back
  1.  . ; gety group name
  1.  . S IB3553GNA=$G(IB5(2.01,"I"))  ; get group name from 'approved' group name field
  1.  . I IB3553GNA="" S IB3553GNA=$G(IB5(.03,"I"))  ; get group name from 'old' field if approved is null
  1.  . I IB3553GNA="" S IB3553GNA="<NO GROUP NAME>"  ; if no group name associated
  1.  . ; get type of plan
  1.  . S IB3553TY=$G(IB5(.09,"E"))
  1.  . I $L(IB3553TY)>25 S:IBOUT="R" IB3553TY=$E(IB3553TY,1,25) I $G(IB5(.09,"I"))'="" D
  1.  .. S:IBOUT="R" IB3553TY=$$GET1^DIQ(355.1,$G(IB5(.09,"I"))_",",.02) ; Abbreviation
  1.  . ; check if individual and if inactive
  1.  . S IBA="" S:'$G(IB5(.02,"I")) IBA="+" S:$G(IB5(.11,"I")) IBA=IBA_"*"
  1.  . S IB3553GNA=IBA_IB3553GNA
  1.  . ; file 36 info
  1.  . ; (#.01)  INSURANCE COMPANY NAME
  1.  . ; (#.05)  INACTIVE  '0' FOR NO; '1' FOR YES
  1.  . ; (#.111) STREET ADDRESS [LINE 1]
  1.  . ; (#.13)  TYPE OF COVERAGE [13P:355.2]
  1.  . K IBARY D GETS^DIQ(36,IB36_",",".01;.05;.111;.13","IE","IBARY")
  1.  . K IBW M IBW=IBARY(36,IB36_",")
  1.  . S IB36N=$G(IBW(.01,"E"))
  1.  . S IB36A1=$G(IBW(.111,"E")) S:IB36A1="" IB36A1=" " S IB36A1=$E(IB36A1,1,34)
  1.  . S IB36N=IB36N
  1.  . S IBA=$G(IBW(.05,"I")),IBINA=$S('IBA:"A",1:"I")
  1.  . I IBTYP=2 D  Q
  1.  .. I $D(^TMP($J,"IBCNOR4","U",($$UP^XLFSTR(IBSI)))) D RSET
  1.  . D RSET
  1.  Q
  1.  ;
  1. RSET ; update TMP to prep for subscriber check
  1.  ;
  1.  I '$D(^TMP($J,"IBCNOR4",1,IBSI)) S ^TMP($J,"IBCNOR4",1,IBSI)=2
  1.  S IBUN=$$UP^XLFSTR(IBSI),^TMP($J,"IBCNOR4",2,IBUN)=1
  1.  ;                     G Nu in nm in addr 355 ien 38 ien  typ pln    g nm
  1.  S ^TMP($J,"IBCNOR4",4,IBSI,IB36N,IB36A1,IBS3553)=IB36_U_IB3553TY_U_IB3553GNA_U_U_U_IBINA
  1.  I IB36&(IBS3553) S ^TMP($J,"IBCNOR4",5,IB36,IBS3553)=0
  1.  I IBTYP=1 D
  1.  . S IBCTL=IBCTL+1,^TMP($J,"IBCNOR4",0)=IBCTL
  1.  Q
  1.  ;
  1. HDRE ; excel header
  1.  ;
  1.  W !,IBHDRNAME,U,IBHDRDATE
  1.  W !,IBFILTER
  1.  W ", + Indicates individual group plan * Indicates inactive group plan"
  1.  W !,"A/I^GROUP NUMBER^GROUP NAME^INSURANCE COMPANY^ADDRESS^TYPE OF PLAN^TOTAL SUBSCRIBERS"
  1.  ;
  1.  Q
  1.  ;
  1. HDRR ; report header
  1.  ;
  1.  N IBA,IBF,IBG
  1.  S IBPGC=IBPGC+1,IBLNC=0 I IBCRT W:$G(IOF)'="" @IOF W:$G(IOF)="" ! S IBLNC=7
  1.  I 'IBCRT W !
  1.  S IBA=$E(IBSPACES,1,(6-$L(IBPGC)))_IBPGC
  1.  W IBHDRNAME,?92,IBHDRDATE,?119,"Page: ",IBA,!
  1.  S:IBLNC=0 IBLNC=6
  1.  W IBFILTER,?57,"+ Indicates individual group plan",?99,"* Indicates inactive group plan",!!
  1.  W "GROUP NUMBER",!
  1.  W ?2,"A/I",?6,"INSURANCE COMPANY",?38,"ADDRESS",?72,"TOTAL SUB",?83,"GROUP NAME",?107,"TYPE OF PLAN"
  1.  W !,$E(IBDASHES,1,132)
  1.  Q
  1.  ;
  1. STOP() ; Determine if user wants to exit out of the whole option
  1.  ; Initialize Variables
  1.  N DIR,DIRUT,X,Y
  1.  W !
  1.  S DIR(0)="Y"
  1.  S DIR("A")="Do you want to exit out of this option entirely"
  1.  S DIR("B")="YES"
  1.  S DIR("?",1)=" Enter YES to immediately exit out of this option."
  1.  S DIR("?")=" Enter NO to return to the previous question."
  1.  D ^DIR K DIR
  1.  I $D(DIRUT)!$D(DIROUT)!$D(DTOUT)!$D(DUOUT) S (IBSTOP,Y)=1 G STOPX
  1.  I 'Y S IBSTOP=0
  1. STOPX ; STOP Exit Point
  1.  Q Y
  1.  ;