- IBCNRPSI ;BHAM ISC/ALA - Group Plan Status Inquiry ;14-NOV-2003
- ;;2.0;INTEGRATED BILLING;**276**;21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- ;**Program Description**
- ; This program select an insurance company and displays group plans
- ; (All, Pharmacy covered or Matched) for that insurance company
- Q
- ;
- EN ; Select an insurance company (inquiry entry point)
- S IBCNRRPT=""
- EN0 ;
- S DIR(0)="350.9,4.06"
- S DIR("A")="Select INSURANCE COMPANY",DIR("??")="^D ADH^IBCNSM3"
- S DIR("?")="Select the Insurance Company for the plan you are entering"
- D ^DIR K DIR S IBCNSP=+Y I Y<1 G EXIT
- I $P($G(^DIC(36,+IBCNSP,0)),"^",2)="N" W !,"This company does not reimburse. "
- I $P($G(^DIC(36,+IBCNSP,0)),"^",5) W !,*7,"Warning: Inactive Company" H 3 K IBCNSP G EXIT
- ;
- TYPE ; Prompt to allow users to inquire for All group plans, Pharmacy group
- ; plans or Matched group plans
- N DIR,DIRUT
- ;
- S DIR(0)="S^A:All Group Plans;P:Pharmacy Group Plans;M:Matched Group Plans"
- S DIR("A")=" Select the type of Group Plans you want to see"
- S DIR("B")="M"
- S DIR("?",1)=" A - All Group Plans"
- S DIR("?",2)=" P - Pharmacy Group Plans"
- S DIR("?",3)=" M - Matched Group Plans"
- D ^DIR K DIR
- I $D(DIRUT) G TYPEX
- S IBCNTYP=Y
- ;
- D EN^IBCNRPS2
- ;
- TYPEX ; TYPE exit point
- ;
- EXIT K IBCNSP,IBCPOL,IBIND,IBMULT,IBSEL,IBW,IBALR,IBGRP,IBCNGP
- K IBCNRRPT,IBCNTYP,ZTDESC,ZTSTOP,X,Y
- Q
- ;
- PRINT ; Entry pt.
- ;
- ; Init vars
- N CRT,MAXCNT,IBPGC,IBBDT,IBEDT,IBPY,IBPXT,IBSRT,IBDTL
- N X,Y,DIR,DTOUT,DUOUT,LIN,TOTALS
- D:'$D(IOF) HOME^%ZIS
- ;
- S (IBPXT,IBPGC)=0
- ;
- ; Determine IO parameters
- I IOST["C-" S MAXCNT=IOSL-3,CRT=1
- E S MAXCNT=IOSL-6,CRT=0
- ;
- D PRINTDT(MAXCNT,IBPGC)
- I $G(ZTSTOP)!IBPXT G EXIT3
- I CRT,IBPGC>0,'$D(ZTQUEUED) D
- . I MAXCNT<51 F LIN=1:1:(MAXCNT-$Y) W !
- . S DIR(0)="E" D ^DIR K DIR
- ;
- EXIT3 ; Exit pt
- Q
- ;
- PRINTDT(MAX,PGC) ; Print data
- ;
- ; Init vars
- N EORMSG,NONEMSG,TOTDASHS,DISPDATA,SORT,CT,PRT1,PRT2
- ;
- S EORMSG="*** END OF REPORT ***"
- S NONEMSG="* * * N O D A T A F O U N D * * *"
- S $P(TOTDASHS,"=",89)=""
- S CT=0
- ;
- ; Display lines of response
- D LINE
- K ^TMP("IBCNR",$J,"DSPDATA")
- Q
- ; Assumes vars from PRINT: CRT,PGC,IBPXT,MAX,SRT,BDT,EDT,PYR,RDTL,MAR
- ; Init vars
- N DIR,X,Y,DTOUT,DUOUT,OFFSET,HDR,DASHES,DASHES2,LIN
- ;
- I CRT,PGC>0,'$D(ZTQUEUED) D I IBPXT G HEADERX
- . I MAX<51 F LIN=1:1:(MAX-$Y) W !
- . S DIR(0)="E" D ^DIR K DIR
- . I $D(DTOUT)!$D(DUOUT) S IBPXT=1 Q
- I $D(ZTQUEUED),$$S^%ZTLOAD() S (ZTSTOP,IBPXT)=1 G HEADERX
- S PGC=PGC+1
- W @IOF,!,?1,"ePHARM GROUP PLAN STATUS INQUIRY"
- S HDR=$$FMTE^XLFDT($$NOW^XLFDT,1)_" Page: "_PGC
- S OFFSET=80-$L(HDR)
- W ?OFFSET,HDR
- W !,?1,"Report for "_$S(IBCNTYP="A":"All",IBCNTYP="P":"Pharmacy Covered",1:"Matched")_" Group Plans for "_$$GET1^DIQ(36,IBCNSP_",",.01)
- W !,?1,"Group Name",?20,"Group #",?38,"Plan Type",?52,"Plan ID"
- W ?71,"Pln Stat"
- S $P(DASHES,"=",80)=""
- W !,?1,DASHES
- ;
- Q
- ;
- LINE ; Print line of data
- ; Assumes vars from PRINT: PGC,IBPXT,MAX
- ; Init vars
- N CT,II
- ;
- S CT=+$O(^TMP("IBCNR",$J,"DSPDATA",""),-1)
- I $Y+1+CT>MAX D HEADER I $G(ZTSTOP)!IBPXT G LINEX
- F II=1:1:CT D Q:$G(ZTSTOP)!IBPXT
- . I $Y+1>MAX!('PGC) D HEADER I $G(ZTSTOP)!IBPXT Q
- . W !,?1,^TMP("IBCNR",$J,"DSPDATA",II)
- . Q
- ;
- LINEX ; LINE exit pt
- Q
- QUITX ;
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNRPSI 3441 printed Feb 18, 2025@23:42:52 Page 2
- IBCNRPSI ;BHAM ISC/ALA - Group Plan Status Inquiry ;14-NOV-2003
- +1 ;;2.0;INTEGRATED BILLING;**276**;21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- +4 ;**Program Description**
- +5 ; This program select an insurance company and displays group plans
- +6 ; (All, Pharmacy covered or Matched) for that insurance company
- +7 QUIT
- +8 ;
- EN ; Select an insurance company (inquiry entry point)
- +1 SET IBCNRRPT=""
- EN0 ;
- +1 SET DIR(0)="350.9,4.06"
- +2 SET DIR("A")="Select INSURANCE COMPANY"
- SET DIR("??")="^D ADH^IBCNSM3"
- +3 SET DIR("?")="Select the Insurance Company for the plan you are entering"
- +4 DO ^DIR
- KILL DIR
- SET IBCNSP=+Y
- IF Y<1
- GOTO EXIT
- +5 IF $PIECE($GET(^DIC(36,+IBCNSP,0)),"^",2)="N"
- WRITE !,"This company does not reimburse. "
- +6 IF $PIECE($GET(^DIC(36,+IBCNSP,0)),"^",5)
- WRITE !,*7,"Warning: Inactive Company"
- HANG 3
- KILL IBCNSP
- GOTO EXIT
- +7 ;
- TYPE ; Prompt to allow users to inquire for All group plans, Pharmacy group
- +1 ; plans or Matched group plans
- +2 NEW DIR,DIRUT
- +3 ;
- +4 SET DIR(0)="S^A:All Group Plans;P:Pharmacy Group Plans;M:Matched Group Plans"
- +5 SET DIR("A")=" Select the type of Group Plans you want to see"
- +6 SET DIR("B")="M"
- +7 SET DIR("?",1)=" A - All Group Plans"
- +8 SET DIR("?",2)=" P - Pharmacy Group Plans"
- +9 SET DIR("?",3)=" M - Matched Group Plans"
- +10 DO ^DIR
- KILL DIR
- +11 IF $DATA(DIRUT)
- GOTO TYPEX
- +12 SET IBCNTYP=Y
- +13 ;
- +14 DO EN^IBCNRPS2
- +15 ;
- TYPEX ; TYPE exit point
- +1 ;
- EXIT KILL IBCNSP,IBCPOL,IBIND,IBMULT,IBSEL,IBW,IBALR,IBGRP,IBCNGP
- +1 KILL IBCNRRPT,IBCNTYP,ZTDESC,ZTSTOP,X,Y
- +2 QUIT
- +3 ;
- PRINT ; Entry pt.
- +1 ;
- +2 ; Init vars
- +3 NEW CRT,MAXCNT,IBPGC,IBBDT,IBEDT,IBPY,IBPXT,IBSRT,IBDTL
- +4 NEW X,Y,DIR,DTOUT,DUOUT,LIN,TOTALS
- +5 if '$DATA(IOF)
- DO HOME^%ZIS
- +6 ;
- +7 SET (IBPXT,IBPGC)=0
- +8 ;
- +9 ; Determine IO parameters
- +10 IF IOST["C-"
- SET MAXCNT=IOSL-3
- SET CRT=1
- +11 IF '$TEST
- SET MAXCNT=IOSL-6
- SET CRT=0
- +12 ;
- +13 DO PRINTDT(MAXCNT,IBPGC)
- +14 IF $GET(ZTSTOP)!IBPXT
- GOTO EXIT3
- +15 IF CRT
- IF IBPGC>0
- IF '$DATA(ZTQUEUED)
- Begin DoDot:1
- +16 IF MAXCNT<51
- FOR LIN=1:1:(MAXCNT-$Y)
- WRITE !
- +17 SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- End DoDot:1
- +18 ;
- EXIT3 ; Exit pt
- +1 QUIT
- +2 ;
- PRINTDT(MAX,PGC) ; Print data
- +1 ;
- +2 ; Init vars
- +3 NEW EORMSG,NONEMSG,TOTDASHS,DISPDATA,SORT,CT,PRT1,PRT2
- +4 ;
- +5 SET EORMSG="*** END OF REPORT ***"
- +6 SET NONEMSG="* * * N O D A T A F O U N D * * *"
- +7 SET $PIECE(TOTDASHS,"=",89)=""
- +8 SET CT=0
- +9 ;
- +10 ; Display lines of response
- +11 DO LINE
- +12 KILL ^TMP("IBCNR",$JOB,"DSPDATA")
- +13 QUIT
- +1 ; Assumes vars from PRINT: CRT,PGC,IBPXT,MAX,SRT,BDT,EDT,PYR,RDTL,MAR
- +2 ; Init vars
- +3 NEW DIR,X,Y,DTOUT,DUOUT,OFFSET,HDR,DASHES,DASHES2,LIN
- +4 ;
- +5 IF CRT
- IF PGC>0
- IF '$DATA(ZTQUEUED)
- Begin DoDot:1
- +6 IF MAX<51
- FOR LIN=1:1:(MAX-$Y)
- WRITE !
- +7 SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- +8 IF $DATA(DTOUT)!$DATA(DUOUT)
- SET IBPXT=1
- QUIT
- End DoDot:1
- IF IBPXT
- GOTO HEADERX
- +9 IF $DATA(ZTQUEUED)
- IF $$S^%ZTLOAD()
- SET (ZTSTOP,IBPXT)=1
- GOTO HEADERX
- +10 SET PGC=PGC+1
- +11 WRITE @IOF,!,?1,"ePHARM GROUP PLAN STATUS INQUIRY"
- +12 SET HDR=$$FMTE^XLFDT($$NOW^XLFDT,1)_" Page: "_PGC
- +13 SET OFFSET=80-$LENGTH(HDR)
- +14 WRITE ?OFFSET,HDR
- +15 WRITE !,?1,"Report for "_$SELECT(IBCNTYP="A":"All",IBCNTYP="P":"Pharmacy Covered",1:"Matched")_" Group Plans for "_$$GET1^DIQ(36,IBCNSP_",",.01)
- +16 WRITE !,?1,"Group Name",?20,"Group #",?38,"Plan Type",?52,"Plan ID"
- +17 WRITE ?71,"Pln Stat"
- +18 SET $PIECE(DASHES,"=",80)=""
- +19 WRITE !,?1,DASHES
- +20 ;
- +1 QUIT
- +2 ;
- LINE ; Print line of data
- +1 ; Assumes vars from PRINT: PGC,IBPXT,MAX
- +2 ; Init vars
- +3 NEW CT,II
- +4 ;
- +5 SET CT=+$ORDER(^TMP("IBCNR",$JOB,"DSPDATA",""),-1)
- +6 IF $Y+1+CT>MAX
- DO HEADER
- IF $GET(ZTSTOP)!IBPXT
- GOTO LINEX
- +7 FOR II=1:1:CT
- Begin DoDot:1
- +8 IF $Y+1>MAX!('PGC)
- DO HEADER
- IF $GET(ZTSTOP)!IBPXT
- QUIT
- +9 WRITE !,?1,^TMP("IBCNR",$JOB,"DSPDATA",II)
- +10 QUIT
- End DoDot:1
- if $GET(ZTSTOP)!IBPXT
- QUIT
- +11 ;
- LINEX ; LINE exit pt
- +1 QUIT
- QUITX ;
- +1 QUIT
