IBCNRRP1 ;BHAM ISC/CMW - Group Plan Worksheet Report ;03-MAR-2004
;;2.0;INTEGRATED BILLING;**251,276**;21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
; e-Pharmacy Group Plan Worksheet Report
;
; Input parameter: N/A
; Other relevant variables:
; IBCNRRTN = "IBCNRRP1" (current routine name for queuing the
; COMPILE process)
; IBCNRSPC("BEGDT") = start date for date range
; IBCNRSPC("ENDDT") = end date for date range
; IBCNRSPC("SORT") = 1 - By Insurance/Group; 2 - Total Claims;
; 3 - Total Charges; 4 - BIN/PCN Exceptions
; IBCNRSPC("MATCH")= 1 - Matched only; 0 - All
;
; Enter only from EN tag ONLY
Q
;
; Entry point
EN ;
; Initialize variables
N STOP,IBCNRRTN,IBCNRSPC,RESORT
D:'$D(IOF) HOME^%ZIS
;
S STOP=0,IBPXT=$G(IBPXT)
S IBCNRRTN="IBCNRRP1"
W @IOF
W !,"ePHARM GROUP PLAN WORKSHEET REPORT",!
W !,"NCPDP process requires that the users match Group Plans to Pharmacy Plans."
W !,"This report will assist users in matching Group Insurance Plans to Pharmacy"
W !," Plans by searching through Billing/Claims file for authorized claims that "
W !," have Group Plans with active Pharmacy Plan coverage."
;
; Prompts
; lock global
L +^XTMP(IBCNRRTN):5 I '$T W !!,"Sorry, Worksheet Report in use." H 2 G EXIT
;Check for prior compile
P10 D RESORT(.RESORT) I STOP G EXIT
I $G(RESORT) G P40
K ^XTMP(IBCNRRTN)
; Date Range parameters
P30 D DTRANGE I STOP G:$$STOP EXIT G P10
; Sort parameters
P40 D SORT I STOP G:$$STOP EXIT G P30
; Select the output device
P100 D DEVICE(IBCNRRTN,.IBCNRSPC) I STOP!IBPXT G:$$STOP EXIT G P40
;
EXIT ; Quit this routine
; unlock global
L -^XTMP(IBCNRRTN)
K IBPXT
Q
;
RESORT(RESORT) ; check for prior compile
NEW DIR,BDT,EDT,RDT,HDR,IBDT,X,Y,DIRUT
I '$D(^XTMP(IBCNRRTN)) Q
S IBDT=$G(^XTMP(IBCNRRTN,0,0))
S BDT=$P(IBDT,U,1),EDT=$P(IBDT,U,2),RDT=$P(IBDT,U,3),RESORT=0
S HDR=$$FMTE^XLFDT(BDT,"5Z")_" - "_$$FMTE^XLFDT(EDT,"5Z")
W !!,"A Report file run on: ",RDT,!,?5," exist for date range: ",HDR,!
S DIR(0)="Y"
S DIR("A")="Do you want to use the existing report file"
S DIR("B")="YES"
S DIR("?",1)=" Enter YES to use the existing report file."
S DIR("?")=" Enter NO to DELETE existing file and recompile,"
D ^DIR K DIR
I $D(DIRUT) S STOP=1 G RESRTX
S RESORT=Y
S IBCNRSPC("RESORT")=Y
S IBCNRSPC("BEGDT")=BDT
S IBCNRSPC("ENDDT")=EDT
;
RESRTX ;RESORT EXIT
Q
;
COMPILE(IBCNRRTN,IBCNRSPC) ;
; Entry point called from EN^XUTMDEVQ in either direct or queued mode.
; Input params:
; IBCNRRTN = Routine name for ^TMP(...
; IBCNRSPC = Array passed by ref of the report params
;
; Init scratch globals
I '$G(IBCNRSPC("RESORT")) D
. ; Compile
. I IBCNRRTN="IBCNRRP1" D EN^IBCNRRP2(IBCNRRTN,.IBCNRSPC)
; Print
I '$G(ZTSTOP) D
. I IBCNRRTN="IBCNRRP1" D EN^IBCNRRP3(IBCNRRTN,.IBCNRSPC)
; Close device
D ^%ZISC
;
; Purge task record
I $D(ZTQUEUED) S ZTREQ="@"
;
COMPILX ; COMPILE exit pt
Q
;
STOP() ; Determine if user wants to exit out of the whole option
; Init vars
N DIR,X,Y,DIRUT
;
W !
S DIR(0)="Y"
S DIR("A")="Do you want to exit out of this option entirely"
S DIR("B")="YES"
S DIR("?",1)=" Enter YES to immediately exit out of this option."
S DIR("?")=" Enter NO to return to the previous question."
D ^DIR K DIR
I $D(DIRUT) S (STOP,Y)=1 G STOPX
I 'Y S STOP=0
;
STOPX ; STOP exit pt
Q Y
;
DTRANGE ; Determine start and end dates for date range param
; Init vars
N X,Y,DIRUT
;
W !
;
S DIR(0)="D^::EX"
S DIR("A")="Start DATE"
S DIR("?",1)=" Please enter a valid date for which an Bill/Claim"
S DIR("?")=" would have been authorized."
D ^DIR K DIR
I $D(DIRUT) S STOP=1 G DTRANGX
S IBCNRSPC("BEGDT")=Y
; End date
DTRANG1 S DIR(0)="D^::EX"
S DIR("A")=" End DATE"
S DIR("?",1)=" Please enter a valid date for which an Bill/Claim"
S DIR("?",2)=" would have been authorized. This date must not precede"
S DIR("?")=" the Start Date."
D ^DIR K DIR
I $D(DIRUT) S STOP=1 G DTRANGX
I Y<IBCNRSPC("BEGDT") D G DTRANG1
. W !," End Date must not precede the Start Date."
. W !," Please reenter."
S IBCNRSPC("ENDDT")=Y
;
DTRANGX ; DTRANGE exit pt
Q
;
SORT ; Prompt to allow users to sort the report
; by Insurance/Group, Max claims, Max charges
NEW DIR,X,Y,DIRUT
;
S DIR(0)="S^1:Insurance/Group;2:Total Claims;3:Total Charges;4:Exceptions Only"
S DIR("A")=" Select the primary sort field"
S DIR("B")=1
S DIR("?",1)=" 1 - Sort all Claims by Insurance/Group. (Default)"
S DIR("?",2)=" 2 - Sort by Groups with the most Claims"
S DIR("?",3)=" 3 - Sort by Groups with the most Charges"
S DIR("?",4)=" 4 - Show BIN/PCN Exceptions only"
D ^DIR K DIR
I $D(DIRUT) S STOP=1 G SORTX
S IBCNRSPC("SORT")=Y
;
;Prompt for All/Matched only
S DIR(0)="SA^A:All;M:Matched Only"
S DIR("A")=" List (A)LL Insurance/Groups or (M)atched Only: "
S DIR("B")="Matched Only"
W ! D ^DIR K DIR
I $D(DIRUT) S STOP=1 G SORTX
S IBCNRSPC("MATCH")=(Y="M")
;
SORTX ; SORT exit point
Q
;
;
DEVICE(IBCNRRTN,IBCNRSPC) ; Device Handler and possible TaskManager calls
;
; Input params:
; IBCNRRTN = Routine name for ^TMP($J,...
; IBCNRSPC = Array passed by ref of the report params
;
; Init vars
N ZTRTN,ZTDESC,ZTSAVE,POP
;
;I IBCNRRTN="IBCNRRP1" W !!!,"*** This report is 132 characters wide ***",!
S ZTRTN="COMPILE^IBCNRRP1("""_IBCNRRTN_""",.IBCNRSPC)"
S ZTDESC="ePHARM GROUP PLAN WORKSHEET REPORT"
S ZTSAVE("IBCNRSPC(")=""
S ZTSAVE("IBCNRRTN")=""
D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE)
I POP S STOP=1
;
DEVICEX ; DEVICE exit pt
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNRRP1 5783 printed Apr 09, 2024@21:22:06 Page 2
IBCNRRP1 ;BHAM ISC/CMW - Group Plan Worksheet Report ;03-MAR-2004
+1 ;;2.0;INTEGRATED BILLING;**251,276**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ; e-Pharmacy Group Plan Worksheet Report
+5 ;
+6 ; Input parameter: N/A
+7 ; Other relevant variables:
+8 ; IBCNRRTN = "IBCNRRP1" (current routine name for queuing the
+9 ; COMPILE process)
+10 ; IBCNRSPC("BEGDT") = start date for date range
+11 ; IBCNRSPC("ENDDT") = end date for date range
+12 ; IBCNRSPC("SORT") = 1 - By Insurance/Group; 2 - Total Claims;
+13 ; 3 - Total Charges; 4 - BIN/PCN Exceptions
+14 ; IBCNRSPC("MATCH")= 1 - Matched only; 0 - All
+15 ;
+16 ; Enter only from EN tag ONLY
+17 QUIT
+18 ;
+19 ; Entry point
EN ;
+1 ; Initialize variables
+2 NEW STOP,IBCNRRTN,IBCNRSPC,RESORT
+3 if '$DATA(IOF)
DO HOME^%ZIS
+4 ;
+5 SET STOP=0
SET IBPXT=$GET(IBPXT)
+6 SET IBCNRRTN="IBCNRRP1"
+7 WRITE @IOF
+8 WRITE !,"ePHARM GROUP PLAN WORKSHEET REPORT",!
+9 WRITE !,"NCPDP process requires that the users match Group Plans to Pharmacy Plans."
+10 WRITE !,"This report will assist users in matching Group Insurance Plans to Pharmacy"
+11 WRITE !," Plans by searching through Billing/Claims file for authorized claims that "
+12 WRITE !," have Group Plans with active Pharmacy Plan coverage."
+13 ;
+14 ; Prompts
+15 ; lock global
+16 LOCK +^XTMP(IBCNRRTN):5
IF '$TEST
WRITE !!,"Sorry, Worksheet Report in use."
HANG 2
GOTO EXIT
+17 ;Check for prior compile
P10 DO RESORT(.RESORT)
IF STOP
GOTO EXIT
+1 IF $GET(RESORT)
GOTO P40
+2 KILL ^XTMP(IBCNRRTN)
+3 ; Date Range parameters
P30 DO DTRANGE
IF STOP
if $$STOP
GOTO EXIT
GOTO P10
+1 ; Sort parameters
P40 DO SORT
IF STOP
if $$STOP
GOTO EXIT
GOTO P30
+1 ; Select the output device
P100 DO DEVICE(IBCNRRTN,.IBCNRSPC)
IF STOP!IBPXT
if $$STOP
GOTO EXIT
GOTO P40
+1 ;
EXIT ; Quit this routine
+1 ; unlock global
+2 LOCK -^XTMP(IBCNRRTN)
+3 KILL IBPXT
+4 QUIT
+5 ;
RESORT(RESORT) ; check for prior compile
+1 NEW DIR,BDT,EDT,RDT,HDR,IBDT,X,Y,DIRUT
+2 IF '$DATA(^XTMP(IBCNRRTN))
QUIT
+3 SET IBDT=$GET(^XTMP(IBCNRRTN,0,0))
+4 SET BDT=$PIECE(IBDT,U,1)
SET EDT=$PIECE(IBDT,U,2)
SET RDT=$PIECE(IBDT,U,3)
SET RESORT=0
+5 SET HDR=$$FMTE^XLFDT(BDT,"5Z")_" - "_$$FMTE^XLFDT(EDT,"5Z")
+6 WRITE !!,"A Report file run on: ",RDT,!,?5," exist for date range: ",HDR,!
+7 SET DIR(0)="Y"
+8 SET DIR("A")="Do you want to use the existing report file"
+9 SET DIR("B")="YES"
+10 SET DIR("?",1)=" Enter YES to use the existing report file."
+11 SET DIR("?")=" Enter NO to DELETE existing file and recompile,"
+12 DO ^DIR
KILL DIR
+13 IF $DATA(DIRUT)
SET STOP=1
GOTO RESRTX
+14 SET RESORT=Y
+15 SET IBCNRSPC("RESORT")=Y
+16 SET IBCNRSPC("BEGDT")=BDT
+17 SET IBCNRSPC("ENDDT")=EDT
+18 ;
RESRTX ;RESORT EXIT
+1 QUIT
+2 ;
COMPILE(IBCNRRTN,IBCNRSPC) ;
+1 ; Entry point called from EN^XUTMDEVQ in either direct or queued mode.
+2 ; Input params:
+3 ; IBCNRRTN = Routine name for ^TMP(...
+4 ; IBCNRSPC = Array passed by ref of the report params
+5 ;
+6 ; Init scratch globals
+7 IF '$GET(IBCNRSPC("RESORT"))
Begin DoDot:1
+8 ; Compile
+9 IF IBCNRRTN="IBCNRRP1"
DO EN^IBCNRRP2(IBCNRRTN,.IBCNRSPC)
End DoDot:1
+10 ; Print
+11 IF '$GET(ZTSTOP)
Begin DoDot:1
+12 IF IBCNRRTN="IBCNRRP1"
DO EN^IBCNRRP3(IBCNRRTN,.IBCNRSPC)
End DoDot:1
+13 ; Close device
+14 DO ^%ZISC
+15 ;
+16 ; Purge task record
+17 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+18 ;
COMPILX ; COMPILE exit pt
+1 QUIT
+2 ;
STOP() ; Determine if user wants to exit out of the whole option
+1 ; Init vars
+2 NEW DIR,X,Y,DIRUT
+3 ;
+4 WRITE !
+5 SET DIR(0)="Y"
+6 SET DIR("A")="Do you want to exit out of this option entirely"
+7 SET DIR("B")="YES"
+8 SET DIR("?",1)=" Enter YES to immediately exit out of this option."
+9 SET DIR("?")=" Enter NO to return to the previous question."
+10 DO ^DIR
KILL DIR
+11 IF $DATA(DIRUT)
SET (STOP,Y)=1
GOTO STOPX
+12 IF 'Y
SET STOP=0
+13 ;
STOPX ; STOP exit pt
+1 QUIT Y
+2 ;
DTRANGE ; Determine start and end dates for date range param
+1 ; Init vars
+2 NEW X,Y,DIRUT
+3 ;
+4 WRITE !
+5 ;
+6 SET DIR(0)="D^::EX"
+7 SET DIR("A")="Start DATE"
+8 SET DIR("?",1)=" Please enter a valid date for which an Bill/Claim"
+9 SET DIR("?")=" would have been authorized."
+10 DO ^DIR
KILL DIR
+11 IF $DATA(DIRUT)
SET STOP=1
GOTO DTRANGX
+12 SET IBCNRSPC("BEGDT")=Y
+13 ; End date
DTRANG1 SET DIR(0)="D^::EX"
+1 SET DIR("A")=" End DATE"
+2 SET DIR("?",1)=" Please enter a valid date for which an Bill/Claim"
+3 SET DIR("?",2)=" would have been authorized. This date must not precede"
+4 SET DIR("?")=" the Start Date."
+5 DO ^DIR
KILL DIR
+6 IF $DATA(DIRUT)
SET STOP=1
GOTO DTRANGX
+7 IF Y<IBCNRSPC("BEGDT")
Begin DoDot:1
+8 WRITE !," End Date must not precede the Start Date."
+9 WRITE !," Please reenter."
End DoDot:1
GOTO DTRANG1
+10 SET IBCNRSPC("ENDDT")=Y
+11 ;
DTRANGX ; DTRANGE exit pt
+1 QUIT
+2 ;
SORT ; Prompt to allow users to sort the report
+1 ; by Insurance/Group, Max claims, Max charges
+2 NEW DIR,X,Y,DIRUT
+3 ;
+4 SET DIR(0)="S^1:Insurance/Group;2:Total Claims;3:Total Charges;4:Exceptions Only"
+5 SET DIR("A")=" Select the primary sort field"
+6 SET DIR("B")=1
+7 SET DIR("?",1)=" 1 - Sort all Claims by Insurance/Group. (Default)"
+8 SET DIR("?",2)=" 2 - Sort by Groups with the most Claims"
+9 SET DIR("?",3)=" 3 - Sort by Groups with the most Charges"
+10 SET DIR("?",4)=" 4 - Show BIN/PCN Exceptions only"
+11 DO ^DIR
KILL DIR
+12 IF $DATA(DIRUT)
SET STOP=1
GOTO SORTX
+13 SET IBCNRSPC("SORT")=Y
+14 ;
+15 ;Prompt for All/Matched only
+16 SET DIR(0)="SA^A:All;M:Matched Only"
+17 SET DIR("A")=" List (A)LL Insurance/Groups or (M)atched Only: "
+18 SET DIR("B")="Matched Only"
+19 WRITE !
DO ^DIR
KILL DIR
+20 IF $DATA(DIRUT)
SET STOP=1
GOTO SORTX
+21 SET IBCNRSPC("MATCH")=(Y="M")
+22 ;
SORTX ; SORT exit point
+1 QUIT
+2 ;
+3 ;
DEVICE(IBCNRRTN,IBCNRSPC) ; Device Handler and possible TaskManager calls
+1 ;
+2 ; Input params:
+3 ; IBCNRRTN = Routine name for ^TMP($J,...
+4 ; IBCNRSPC = Array passed by ref of the report params
+5 ;
+6 ; Init vars
+7 NEW ZTRTN,ZTDESC,ZTSAVE,POP
+8 ;
+9 ;I IBCNRRTN="IBCNRRP1" W !!!,"*** This report is 132 characters wide ***",!
+10 SET ZTRTN="COMPILE^IBCNRRP1("""_IBCNRRTN_""",.IBCNRSPC)"
+11 SET ZTDESC="ePHARM GROUP PLAN WORKSHEET REPORT"
+12 SET ZTSAVE("IBCNRSPC(")=""
+13 SET ZTSAVE("IBCNRRTN")=""
+14 DO EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE)
+15 IF POP
SET STOP=1
+16 ;
DEVICEX ; DEVICE exit pt
+1 QUIT
+2 ;
