IBCNRP5P ;BHAM ISC/CMW - Group Plan Status Report ;01-NOV-2004
;;2.0;INTEGRATED BILLING;**276**;21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
PRINT ; Entry pt.
;
; Init vars
N CRT,MAXCNT,IBPGC,IBBDT,IBEDT,IBPY,IBPXT,IBSRT,IBDTL
N X,Y,DIR,DTOUT,DUOUT,LIN,TOTALS,ZTRTN,ZTDESC,ZTSAVE
D:'$D(IOF) HOME^%ZIS
S ZTRTN="PRT01^IBCNRP5P"
S ZTDESC="ePHARM GROUP PLAN STATUS REPORT"
S ZTSAVE("^TMP(""IBCNRP5"",$J,")="",ZTSAVE("IBCNTYP")=""
D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE)
Q
;
PRT01 ;
S (IBPXT,IBPGC)=0
;
; Determine IO parameters
I IOST["C-" S MAXCNT=IOSL-3,CRT=1
E S MAXCNT=IOSL-6,CRT=0
;
D PRT02(MAXCNT,IBPGC)
I $G(ZTSTOP)!IBPXT G PRTEX
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
;
PRTEX Q
;
PRT02(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
Q
;
LINE ; Print line of data
; Assumes vars from PRINT: PGC,IBPXT,MAX
; Init vars
N CT,II,DSP,IBCNSP
;
S CT=+$O(^TMP("IBCNRP5",$J,"DSPDATA",""),-1)
S IBCNSP=$P(^TMP("IBCNRP5",$J,"DSPDATA",1),U)
I $Y+1+CT>MAX D HEADER I $G(ZTSTOP)!IBPXT G LINEX
F II=1:1:CT D Q:$G(ZTSTOP)!IBPXT
. S IBCNSP=$P(^TMP("IBCNRP5",$J,"DSPDATA",II),U)
. I $Y+1>MAX!('PGC) D HEADER I $G(ZTSTOP)!IBPXT Q
. S DSP=$P(^TMP("IBCNRP5",$J,"DSPDATA",II),U,2)
. W !,?1,DSP
. Q
;
LINEX ; LINE exit pt
Q
QUITX ;
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 REPORT"
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 "
W $$GET1^DIQ(36,IBCNSP_",",.01)_" "_$$GET1^DIQ(36,IBCNSP_",",.111)
W !,?1,"Group Name",?20,"Group #",?38,"Plan Type",?52,"Plan ID"
W ?71,"Pln Stat"
S $P(DASHES,"=",80)=""
W !,?1,DASHES
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNRP5P 2508 printed Apr 09, 2024@21:34:47 Page 2
IBCNRP5P ;BHAM ISC/CMW - Group Plan Status Report ;01-NOV-2004
+1 ;;2.0;INTEGRATED BILLING;**276**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+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,ZTRTN,ZTDESC,ZTSAVE
+5 if '$DATA(IOF)
DO HOME^%ZIS
+6 SET ZTRTN="PRT01^IBCNRP5P"
+7 SET ZTDESC="ePHARM GROUP PLAN STATUS REPORT"
+8 SET ZTSAVE("^TMP(""IBCNRP5"",$J,")=""
SET ZTSAVE("IBCNTYP")=""
+9 DO EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE)
+10 QUIT
+11 ;
PRT01 ;
+1 SET (IBPXT,IBPGC)=0
+2 ;
+3 ; Determine IO parameters
+4 IF IOST["C-"
SET MAXCNT=IOSL-3
SET CRT=1
+5 IF '$TEST
SET MAXCNT=IOSL-6
SET CRT=0
+6 ;
+7 DO PRT02(MAXCNT,IBPGC)
+8 IF $GET(ZTSTOP)!IBPXT
GOTO PRTEX
+9 IF CRT
IF IBPGC>0
IF '$DATA(ZTQUEUED)
Begin DoDot:1
+10 IF MAXCNT<51
FOR LIN=1:1:(MAXCNT-$Y)
WRITE !
+11 SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:1
+12 ;
PRTEX QUIT
+1 ;
PRT02(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 QUIT
+13 ;
LINE ; Print line of data
+1 ; Assumes vars from PRINT: PGC,IBPXT,MAX
+2 ; Init vars
+3 NEW CT,II,DSP,IBCNSP
+4 ;
+5 SET CT=+$ORDER(^TMP("IBCNRP5",$JOB,"DSPDATA",""),-1)
+6 SET IBCNSP=$PIECE(^TMP("IBCNRP5",$JOB,"DSPDATA",1),U)
+7 IF $Y+1+CT>MAX
DO HEADER
IF $GET(ZTSTOP)!IBPXT
GOTO LINEX
+8 FOR II=1:1:CT
Begin DoDot:1
+9 SET IBCNSP=$PIECE(^TMP("IBCNRP5",$JOB,"DSPDATA",II),U)
+10 IF $Y+1>MAX!('PGC)
DO HEADER
IF $GET(ZTSTOP)!IBPXT
QUIT
+11 SET DSP=$PIECE(^TMP("IBCNRP5",$JOB,"DSPDATA",II),U,2)
+12 WRITE !,?1,DSP
+13 QUIT
End DoDot:1
if $GET(ZTSTOP)!IBPXT
QUIT
+14 ;
LINEX ; LINE exit pt
+1 QUIT
QUITX ;
+1 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 REPORT"
+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 "
+16 WRITE $$GET1^DIQ(36,IBCNSP_",",.01)_" "_$$GET1^DIQ(36,IBCNSP_",",.111)
+17 WRITE !,?1,"Group Name",?20,"Group #",?38,"Plan Type",?52,"Plan ID"
+18 WRITE ?71,"Pln Stat"
+19 SET $PIECE(DASHES,"=",80)=""
+20 WRITE !,?1,DASHES
+21 ;
+1 QUIT
