- 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 Jan 18, 2025@03:17:35 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