IBNCPDRB ;ALB/CFS - ROI EXPIRATION REPORT ;21-SEP-15
;;2.0;INTEGRATED BILLING;**550**;21-MAR-94;Build 25
;;Per VA Directive 6402, this routine should not be modified.
;
Q
REPORT(RPTNAME,DATESEL,AIB,IBEXCEL) ;
; RPTNAME = Report name
; DATESEL = Earliest and Latest expiration dates selected by user (format: earliest^latest)
; AIB = "A" - User chose to display Active statuses only
; "I" - User chose to display on Inactive statuses only
; "B" - User chose to display Active and Inactive statuses
; IBEXCEL = 1 if the user requested to print in EXCEL format; 0 otherwise
N IBEDATE,IBLDATE,IBPAGE,CRT
S RPTNAME=$G(RPTNAME),DATESEL=$G(DATESEL)
S IBEDATE=$$FMTE^XLFDT($P(DATESEL,U),"5DZ") ; Earliest expiration date selected.
S IBLDATE=$$FMTE^XLFDT($P(DATESEL,U,2),"5DZ") ; Latest expiration date selected.
S CRT=$S(IOST["C-":1,1:0) ; Screen variable.
I IBEXCEL D EXCELHDR
I 'IBEXCEL D HEADER
D GETTMP
Q
;
EXCELHDR ;
; Print headers in EXCEL format.
W !,"Patient name^Date of Death^Effective Date^Expiration Date^Status^Date Added^Entered By^Insurance Name^Drug Name"
Q
;
N DASH,NOW
S DASH=""
W @IOF
S IBPAGE=$G(IBPAGE)+1
S $P(DASH,"-",133)=""
W !,RPTNAME,?119,"Page: ",?126,IBPAGE
S NOW=$$NOW^XLFDT(),NOW=$$FMTE^XLFDT(NOW,1)
W !,"Date Range: "_IBEDATE_" - "_IBLDATE,?101,"Run Date: "_NOW
W !,"Status: ",$S(AIB="A":"Active ROIs",AIB="I":"Inactive ROIs",1:"All")
W !,DASH
W !,?23,"Date of",?33,"Eff.",?44,"Exp.",?60,"Date"
W !,"Patient Name",?23,"Death",?33,"Date",?44,"Date",?55,"St",?60,"Added",?71,"Entered By"
W ?90,"Insurance Name",?110,"Drug Name"
W !,DASH
Q
GETTMP ;
; Get the data from the scratch global.
N ADDED,DATA,DOD,DRUGNAME,EXPDATE,EFFDATE,IBQ,INSNAME,PATNAME,SUB1,SUB2,SUB3
N USERNAME
S IBQ=0
I '$D(^TMP("IBNCPDRA",$J)) D Q
. I 'IBEXCEL W !!,?51,"***** NO DATA TO REPORT *****",! S:CRT&'$D(ZTQUEUED) IBQ=$$PAUSE() Q
. W !,"***** NO DATA TO REPORT *****",! S IBQ=$$PAUSE()
S SUB1="" F S SUB1=$O(^TMP("IBNCPDRA",$J,SUB1),-1) Q:SUB1=""!($G(IBQ)) D
. S SUB2="" F S SUB2=$O(^TMP("IBNCPDRA",$J,SUB1,SUB2)) Q:SUB2=""!($G(IBQ)) D
.. S SUB3="" F S SUB3=$O(^TMP("IBNCPDRA",$J,SUB1,SUB2,SUB3)) Q:SUB3=""!($G(IBQ)) D
... S DATA=^TMP("IBNCPDRA",$J,SUB1,SUB2,SUB3)
... S DOD=$$FMTE^XLFDT($P(DATA,U),"2DZ") ; date of death
... S EFFDATE=$$FMTE^XLFDT($P(DATA,U,2),"2DZ") ; effective date of ROI
... S STATUS=$P(DATA,U,3) ; "A" for Active; "I" for Inactive
... S ADDED=$$FMTE^XLFDT($P(DATA,U,4),"2DZ") ; date added to Claims Tracking ROI file
... S USERNAME=$P(DATA,U,5) ; user who added the ROI entry
... S INSNAME=$P(DATA,U,6) ; insurance name
... S DRUGNAME=$P(DATA,U,7) ; drug name
... S EXPDATE=$$FMTE^XLFDT(SUB1,"2DZ") ; expiration date of ROI
... S PATNAME=SUB2 ; patient name
... I IBEXCEL D EXCELN(PATNAME,DOD,EFFDATE,EXPDATE,STATUS,ADDED,USERNAME,INSNAME,DRUGNAME) Q
... D WRTDATA(PATNAME,DOD,EFFDATE,EXPDATE,STATUS,ADDED,USERNAME,INSNAME,DRUGNAME) Q:$G(IBQ)
I $G(IBQ) Q
I 'IBEXCEL W !!,"*** END OF REPORT ***",!
I CRT,'$D(ZTQUEUED) S IBQ=$$PAUSE() ; Write the pause statement to screen only.
Q
;
EXCELN(PATNAME,DOD,EFFDATE,EXPDATE,STATUS,ADDED,USERNAME,INSNAME,DRUGNAME) ;
; Display data in EXCEL format
S STATUS=$S(STATUS="A":"Active",1:"Inactive")
W !,PATNAME,"^",DOD,"^",EFFDATE,"^",EXPDATE,"^",STATUS,"^",ADDED,"^",USERNAME,"^",INSNAME,"^",DRUGNAME
Q
;
WRTDATA(PATNAME,DOD,EFFDATE,EXPDATE,STATUS,ADDED,USERNAME,INSNAME,DRUGNAME) ;
; Display the data to screen or to ListMan Queued report depending on user request.
W !,$E(PATNAME,1,21),?23,DOD,?33,EFFDATE,?44,EXPDATE
W ?55,STATUS,?60,ADDED,?71,$E(USERNAME,1,16),?90,$E(INSNAME,1,17),?110,$E(DRUGNAME,1,22)
I $Y>(IOSL-4) D
. I CRT,'$D(ZTQUEUED) W ! S IBQ=$$PAUSE() ; Write the pause statement to screen only.
. I $G(IBQ) Q ; User chooses to exit report with "^".
. D HEADER
Q
;
PAUSE() ;
; Press RETURN to continue or '^' to exit.
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,QUIT,X,Y
S QUIT=0
I IBEXCEL W !
S DIR(0)="E" D ^DIR K DIR
I $D(DIRUT) S QUIT=1
Q QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBNCPDRB 4278 printed Apr 09, 2024@21:12:21 Page 2
IBNCPDRB ;ALB/CFS - ROI EXPIRATION REPORT ;21-SEP-15
+1 ;;2.0;INTEGRATED BILLING;**550**;21-MAR-94;Build 25
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
REPORT(RPTNAME,DATESEL,AIB,IBEXCEL) ;
+1 ; RPTNAME = Report name
+2 ; DATESEL = Earliest and Latest expiration dates selected by user (format: earliest^latest)
+3 ; AIB = "A" - User chose to display Active statuses only
+4 ; "I" - User chose to display on Inactive statuses only
+5 ; "B" - User chose to display Active and Inactive statuses
+6 ; IBEXCEL = 1 if the user requested to print in EXCEL format; 0 otherwise
+7 NEW IBEDATE,IBLDATE,IBPAGE,CRT
+8 SET RPTNAME=$GET(RPTNAME)
SET DATESEL=$GET(DATESEL)
+9 ; Earliest expiration date selected.
SET IBEDATE=$$FMTE^XLFDT($PIECE(DATESEL,U),"5DZ")
+10 ; Latest expiration date selected.
SET IBLDATE=$$FMTE^XLFDT($PIECE(DATESEL,U,2),"5DZ")
+11 ; Screen variable.
SET CRT=$SELECT(IOST["C-":1,1:0)
+12 IF IBEXCEL
DO EXCELHDR
+13 IF 'IBEXCEL
DO HEADER
+14 DO GETTMP
+15 QUIT
+16 ;
EXCELHDR ;
+1 ; Print headers in EXCEL format.
+2 WRITE !,"Patient name^Date of Death^Effective Date^Expiration Date^Status^Date Added^Entered By^Insurance Name^Drug Name"
+3 QUIT
+4 ;
+1 NEW DASH,NOW
+2 SET DASH=""
+3 WRITE @IOF
+4 SET IBPAGE=$GET(IBPAGE)+1
+5 SET $PIECE(DASH,"-",133)=""
+6 WRITE !,RPTNAME,?119,"Page: ",?126,IBPAGE
+7 SET NOW=$$NOW^XLFDT()
SET NOW=$$FMTE^XLFDT(NOW,1)
+8 WRITE !,"Date Range: "_IBEDATE_" - "_IBLDATE,?101,"Run Date: "_NOW
+9 WRITE !,"Status: ",$SELECT(AIB="A":"Active ROIs",AIB="I":"Inactive ROIs",1:"All")
+10 WRITE !,DASH
+11 WRITE !,?23,"Date of",?33,"Eff.",?44,"Exp.",?60,"Date"
+12 WRITE !,"Patient Name",?23,"Death",?33,"Date",?44,"Date",?55,"St",?60,"Added",?71,"Entered By"
+13 WRITE ?90,"Insurance Name",?110,"Drug Name"
+14 WRITE !,DASH
+15 QUIT
GETTMP ;
+1 ; Get the data from the scratch global.
+2 NEW ADDED,DATA,DOD,DRUGNAME,EXPDATE,EFFDATE,IBQ,INSNAME,PATNAME,SUB1,SUB2,SUB3
+3 NEW USERNAME
+4 SET IBQ=0
+5 IF '$DATA(^TMP("IBNCPDRA",$JOB))
Begin DoDot:1
+6 IF 'IBEXCEL
WRITE !!,?51,"***** NO DATA TO REPORT *****",!
if CRT&'$DATA(ZTQUEUED)
SET IBQ=$$PAUSE()
QUIT
+7 WRITE !,"***** NO DATA TO REPORT *****",!
SET IBQ=$$PAUSE()
End DoDot:1
QUIT
+8 SET SUB1=""
FOR
SET SUB1=$ORDER(^TMP("IBNCPDRA",$JOB,SUB1),-1)
if SUB1=""!($GET(IBQ))
QUIT
Begin DoDot:1
+9 SET SUB2=""
FOR
SET SUB2=$ORDER(^TMP("IBNCPDRA",$JOB,SUB1,SUB2))
if SUB2=""!($GET(IBQ))
QUIT
Begin DoDot:2
+10 SET SUB3=""
FOR
SET SUB3=$ORDER(^TMP("IBNCPDRA",$JOB,SUB1,SUB2,SUB3))
if SUB3=""!($GET(IBQ))
QUIT
Begin DoDot:3
+11 SET DATA=^TMP("IBNCPDRA",$JOB,SUB1,SUB2,SUB3)
+12 ; date of death
SET DOD=$$FMTE^XLFDT($PIECE(DATA,U),"2DZ")
+13 ; effective date of ROI
SET EFFDATE=$$FMTE^XLFDT($PIECE(DATA,U,2),"2DZ")
+14 ; "A" for Active; "I" for Inactive
SET STATUS=$PIECE(DATA,U,3)
+15 ; date added to Claims Tracking ROI file
SET ADDED=$$FMTE^XLFDT($PIECE(DATA,U,4),"2DZ")
+16 ; user who added the ROI entry
SET USERNAME=$PIECE(DATA,U,5)
+17 ; insurance name
SET INSNAME=$PIECE(DATA,U,6)
+18 ; drug name
SET DRUGNAME=$PIECE(DATA,U,7)
+19 ; expiration date of ROI
SET EXPDATE=$$FMTE^XLFDT(SUB1,"2DZ")
+20 ; patient name
SET PATNAME=SUB2
+21 IF IBEXCEL
DO EXCELN(PATNAME,DOD,EFFDATE,EXPDATE,STATUS,ADDED,USERNAME,INSNAME,DRUGNAME)
QUIT
+22 DO WRTDATA(PATNAME,DOD,EFFDATE,EXPDATE,STATUS,ADDED,USERNAME,INSNAME,DRUGNAME)
if $GET(IBQ)
QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+23 IF $GET(IBQ)
QUIT
+24 IF 'IBEXCEL
WRITE !!,"*** END OF REPORT ***",!
+25 ; Write the pause statement to screen only.
IF CRT
IF '$DATA(ZTQUEUED)
SET IBQ=$$PAUSE()
+26 QUIT
+27 ;
EXCELN(PATNAME,DOD,EFFDATE,EXPDATE,STATUS,ADDED,USERNAME,INSNAME,DRUGNAME) ;
+1 ; Display data in EXCEL format
+2 SET STATUS=$SELECT(STATUS="A":"Active",1:"Inactive")
+3 WRITE !,PATNAME,"^",DOD,"^",EFFDATE,"^",EXPDATE,"^",STATUS,"^",ADDED,"^",USERNAME,"^",INSNAME,"^",DRUGNAME
+4 QUIT
+5 ;
WRTDATA(PATNAME,DOD,EFFDATE,EXPDATE,STATUS,ADDED,USERNAME,INSNAME,DRUGNAME) ;
+1 ; Display the data to screen or to ListMan Queued report depending on user request.
+2 WRITE !,$EXTRACT(PATNAME,1,21),?23,DOD,?33,EFFDATE,?44,EXPDATE
+3 WRITE ?55,STATUS,?60,ADDED,?71,$EXTRACT(USERNAME,1,16),?90,$EXTRACT(INSNAME,1,17),?110,$EXTRACT(DRUGNAME,1,22)
+4 IF $Y>(IOSL-4)
Begin DoDot:1
+5 ; Write the pause statement to screen only.
IF CRT
IF '$DATA(ZTQUEUED)
WRITE !
SET IBQ=$$PAUSE()
+6 ; User chooses to exit report with "^".
IF $GET(IBQ)
QUIT
+7 DO HEADER
End DoDot:1
+8 QUIT
+9 ;
PAUSE() ;
+1 ; Press RETURN to continue or '^' to exit.
+2 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,QUIT,X,Y
+3 SET QUIT=0
+4 IF IBEXCEL
WRITE !
+5 SET DIR(0)="E"
DO ^DIR
KILL DIR
+6 IF $DATA(DIRUT)
SET QUIT=1
+7 QUIT QUIT
