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 Dec 13, 2024@02:16:28 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
