IBNCPDRA ;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.
;; External reference to ^PSS50 supported by DBIA #4533
;
Q
;
EN ;
N AIB,DEV,DATESEL,IBEXCEL
W @IOF,!,"Release of Information Expiration Report",!!
S DATESEL=$$DATE() ; Date selection, (return format "beginning date^ending date")
I DATESEL="^" W @IOF Q
S AIB=$$SELAIB() ;"Active", "Inactive" or "Both" selection.
I AIB="^" W @IOF Q
S IBEXCEL=$$EXCEL() ;Microsoft EXCEL prompt selection.
I IBEXCEL="^" W @IOF Q
S DEV=$$DEVICE()
W @IOF
Q
;
; Validate user inputs.
DATE() ; Beginning expiration date and ending expiration date selection prompts.
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,VAL,X,Y
S VAL="",DIR(0)="DA^::EX",DIR("A")="Beginning Expiration Date: ",DIR("B")="T-180"
W ! D ^DIR
K DIR
I $D(DIRUT) Q "^" ; Abort
S $P(VAL,U)=Y
S DIR(0)="DA^"_VAL_"::EX",DIR("A")="Ending Expiration Date: ",DIR("B")="T+60"
D ^DIR
K DIR
I $D(DIRUT) Q "^" ; Abort
S $P(VAL,U,2)=Y
Q VAL
;
SELAIB() ; (A)ctive, (I)nactive or (B)oth selection prompt.
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="S^A:Active;I:Inactive;B:Both"
S DIR("A")="Display (A)ctive or (I)nactive or (B)oth ROI Status",DIR("B")="Both"
D ^DIR
K DIR
I $D(DIRUT) Q "^" ; Abort
Q Y
;
EXCEL() ; Export the report to MS Excel?
; Function return values:
; 0 - User selected "No" at prompt.
; 1 - User selected "Yes" at prompt.
; ^ - User aborted.
; This function allows the user to indicate whether the report should be
; printed in a format that could easily be imported into an Excel
; spreadsheet. If the user wants to print in EXCEL format, the variable
; IBEXCEL will be set to '1', otherwise IBEXCEL will be set to '0' for "No"
; or "^" to abort.
;
N DIR,DIRUT,Y
S DIR(0)="Y"
S DIR("A")="Export the report to Microsoft Excel (Y/N)"
I $G(IBEXCEL)=1 S DIR("B")="YES"
E S DIR("B")="NO"
S DIR("?",1)="If you want to capture the output from this report in a format that"
S DIR("?",2)="could easily be imported into an Excel spreadsheet, then answer YES here."
S DIR("?")="If you want a normal report output, then answer NO here."
W !
D ^DIR
K DIR
I $D(DIRUT) Q "^" ; Abort
Q +Y
;
DEVICE() ; Device selection.
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,RET,RPTNAME,X,Y,ZTDESC,ZTRTN,ZTSAVE,ZTSK
S RET=1
S RPTNAME="Release of Information Expiration Report"
I 'IBEXCEL D
. W !!,"WARNING - THIS REPORT REQUIRES THAT A DEVICE WITH 132 COLUMN WIDTH BE USED."
. W !,"IT WILL NOT DISPLAY CORRECTLY USING 80 COLUMN WIDTH DEVICES",!
I IBEXCEL D
. W !!?5,"Before continuing, please set up your terminal to capture the"
. W !?5,"detail report data and save the detail report data in a text file"
. W !?5,"to a local drive. This report may take a while to run."
. W !!?5,"Note: To avoid undesired wrapping of the data saved to the file,"
. W !?11,"please enter '0;256;99999' at the 'DEVICE:' prompt.",!
. Q
S ZTRTN="COMPILE^IBNCPDRA(RPTNAME,DATESEL,AIB,IBEXCEL)"
S ZTDESC="IB REPORT: "_RPTNAME
S ZTSAVE("RPTNAME")=""
S ZTSAVE("DATESEL")=""
S ZTSAVE("AIB")=""
S ZTSAVE("IBEXCEL")=""
D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"QM",1)
I POP S RET=0
I $G(ZTSK) W !!,"Report compilation has started with task# ",ZTSK,".",! S DIR(0)="E" D ^DIR K DIR
Q RET
;
COMPILE(RPTNAME,DATESEL,AIB,IBEXCEL) ; Compile the report.
; RPTNAME = Report Name
; DATESEL = The earliest and latest expiration dates (format: earliest^latest).
; AIB = Active, Inactive or Both.
; IBEXCEL = 1 if user requested to display in EXCEL format; 0 otherwise.
K ^TMP("IBNCPDRA",$J)
I '$D(ZTQUEUED),'IBEXCEL U 0 W !,"Compiling Release of Information Expiration Report. Please wait..." U IO
; Collect the data
D GETDATA(DATESEL,AIB)
; Display the report
D REPORT^IBNCPDRB(RPTNAME,DATESEL,AIB,IBEXCEL)
D ^%ZISC
K ^TMP("IBNCPDRA",$J)
I $D(ZTQUEUED) S ZTREQ="@"
Q
;
GETDATA(DATES,AIB) ; Get the data from ^IBT(356.25)
; DATES = The earliest and latest expiration dates (format: earliest^latest).
; AIB = Active, Inactive or Both
N ACTIVE,ADDED,CNT,DATE1,DATE2,D0,DOD,DPTIEN,DRUG,DRUGNAME,EFFDATE,ENTERDBY
N EXPDATE,INS,INSNAME,PATNAME,NODE0,NODE1,STATUS,USERIEN
S DATE1=$P(DATES,U),DATE2=$P(DATES,U,2)
S CNT=0
S D0=0 F S D0=$O(^IBT(356.25,D0)) Q:'D0 D
. S (DRUGNAME,ENTERDBY,INSNAME,PATNAME)=""
. S CNT=CNT+1
. I CNT#1000=0,'$D(ZTQUEUED) U 0 W "." U IO ; Write another dot after "Please wait..."
. S NODE0=$G(^IBT(356.25,D0,0)),NODE1=$G(^IBT(356.25,D0,1))
. S DPTIEN=$P(NODE0,U,2) ; patient ien to ^DPT file
. S DRUG=$P(NODE0,U,3) ; drug ien to ^PSDRUG file
. S INS=$P(NODE0,U,4) ; insurance ien to ^DIC(36
. S EFFDATE=$P(NODE0,U,5) ; effective date of ROI
. S EXPDATE=$P(NODE0,U,6) ; expiration date of ROI
. S ACTIVE=$P(NODE0,U,7) ; active? (0=no; 1=yes)
. S ADDED=$P(NODE1,U) ; date added to ROI Claims Tracking file
. S USERIEN=$P(NODE1,U,2) ; user who added the ROI entry
. I EXPDATE="" Q
. I EXPDATE<DATE1!(EXPDATE>DATE2) Q
. I AIB="I",ACTIVE Q
. I AIB="A",'ACTIVE Q
. I DPTIEN'="" S PATNAME=$P($G(^DPT(DPTIEN,0)),U)
. I PATNAME="" Q
. S DOD=$P($G(^DPT(DPTIEN,.35)),U) ; date of death
. S STATUS=$S(ACTIVE:"A",1:"I")
. I USERIEN'="" S ENTERDBY=$P($G(^VA(200,USERIEN,0)),U)
. I ENTERDBY="" S ENTERDBY="UNKNOWN"
. I DRUG'="" S DRUGNAME=$$DRUG(DRUG)
. I DRUGNAME="" S DRUGNAME="NO DRUG NAME"
. I INS'="" S INSNAME=$P($G(^DIC(36,INS,0)),U)
. I INSNAME="" S INSNAME="NO INSURANCE NAME"
. S ^TMP("IBNCPDRA",$J,EXPDATE,PATNAME,D0)=DOD_U_EFFDATE_U_STATUS_U_ADDED_U_ENTERDBY_U_INSNAME_U_DRUGNAME
Q
; Get drug info
DRUG(DRUGIEN) ; Get drug name
; DRUGIEN = drug ien pointer
N X
K ^TMP($J,"IBNCPDRA_DRUG")
D DATA^PSS50(DRUGIEN,"","","","","IBNCPDRA_DRUG") ;DBIA #4533
S X=$G(^TMP($J,"IBNCPDRA_DRUG",DRUGIEN,.01))
K ^TMP($J,"IBNCPDRA_DRUG")
Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBNCPDRA 6038 printed Oct 16, 2024@18:25:32 Page 2
IBNCPDRA ;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 ;; External reference to ^PSS50 supported by DBIA #4533
+4 ;
+5 QUIT
+6 ;
EN ;
+1 NEW AIB,DEV,DATESEL,IBEXCEL
+2 WRITE @IOF,!,"Release of Information Expiration Report",!!
+3 ; Date selection, (return format "beginning date^ending date")
SET DATESEL=$$DATE()
+4 IF DATESEL="^"
WRITE @IOF
QUIT
+5 ;"Active", "Inactive" or "Both" selection.
SET AIB=$$SELAIB()
+6 IF AIB="^"
WRITE @IOF
QUIT
+7 ;Microsoft EXCEL prompt selection.
SET IBEXCEL=$$EXCEL()
+8 IF IBEXCEL="^"
WRITE @IOF
QUIT
+9 SET DEV=$$DEVICE()
+10 WRITE @IOF
+11 QUIT
+12 ;
+13 ; Validate user inputs.
DATE() ; Beginning expiration date and ending expiration date selection prompts.
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,VAL,X,Y
+2 SET VAL=""
SET DIR(0)="DA^::EX"
SET DIR("A")="Beginning Expiration Date: "
SET DIR("B")="T-180"
+3 WRITE !
DO ^DIR
+4 KILL DIR
+5 ; Abort
IF $DATA(DIRUT)
QUIT "^"
+6 SET $PIECE(VAL,U)=Y
+7 SET DIR(0)="DA^"_VAL_"::EX"
SET DIR("A")="Ending Expiration Date: "
SET DIR("B")="T+60"
+8 DO ^DIR
+9 KILL DIR
+10 ; Abort
IF $DATA(DIRUT)
QUIT "^"
+11 SET $PIECE(VAL,U,2)=Y
+12 QUIT VAL
+13 ;
SELAIB() ; (A)ctive, (I)nactive or (B)oth selection prompt.
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+2 SET DIR(0)="S^A:Active;I:Inactive;B:Both"
+3 SET DIR("A")="Display (A)ctive or (I)nactive or (B)oth ROI Status"
SET DIR("B")="Both"
+4 DO ^DIR
+5 KILL DIR
+6 ; Abort
IF $DATA(DIRUT)
QUIT "^"
+7 QUIT Y
+8 ;
EXCEL() ; Export the report to MS Excel?
+1 ; Function return values:
+2 ; 0 - User selected "No" at prompt.
+3 ; 1 - User selected "Yes" at prompt.
+4 ; ^ - User aborted.
+5 ; This function allows the user to indicate whether the report should be
+6 ; printed in a format that could easily be imported into an Excel
+7 ; spreadsheet. If the user wants to print in EXCEL format, the variable
+8 ; IBEXCEL will be set to '1', otherwise IBEXCEL will be set to '0' for "No"
+9 ; or "^" to abort.
+10 ;
+11 NEW DIR,DIRUT,Y
+12 SET DIR(0)="Y"
+13 SET DIR("A")="Export the report to Microsoft Excel (Y/N)"
+14 IF $GET(IBEXCEL)=1
SET DIR("B")="YES"
+15 IF '$TEST
SET DIR("B")="NO"
+16 SET DIR("?",1)="If you want to capture the output from this report in a format that"
+17 SET DIR("?",2)="could easily be imported into an Excel spreadsheet, then answer YES here."
+18 SET DIR("?")="If you want a normal report output, then answer NO here."
+19 WRITE !
+20 DO ^DIR
+21 KILL DIR
+22 ; Abort
IF $DATA(DIRUT)
QUIT "^"
+23 QUIT +Y
+24 ;
DEVICE() ; Device selection.
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,RET,RPTNAME,X,Y,ZTDESC,ZTRTN,ZTSAVE,ZTSK
+2 SET RET=1
+3 SET RPTNAME="Release of Information Expiration Report"
+4 IF 'IBEXCEL
Begin DoDot:1
+5 WRITE !!,"WARNING - THIS REPORT REQUIRES THAT A DEVICE WITH 132 COLUMN WIDTH BE USED."
+6 WRITE !,"IT WILL NOT DISPLAY CORRECTLY USING 80 COLUMN WIDTH DEVICES",!
End DoDot:1
+7 IF IBEXCEL
Begin DoDot:1
+8 WRITE !!?5,"Before continuing, please set up your terminal to capture the"
+9 WRITE !?5,"detail report data and save the detail report data in a text file"
+10 WRITE !?5,"to a local drive. This report may take a while to run."
+11 WRITE !!?5,"Note: To avoid undesired wrapping of the data saved to the file,"
+12 WRITE !?11,"please enter '0;256;99999' at the 'DEVICE:' prompt.",!
+13 QUIT
End DoDot:1
+14 SET ZTRTN="COMPILE^IBNCPDRA(RPTNAME,DATESEL,AIB,IBEXCEL)"
+15 SET ZTDESC="IB REPORT: "_RPTNAME
+16 SET ZTSAVE("RPTNAME")=""
+17 SET ZTSAVE("DATESEL")=""
+18 SET ZTSAVE("AIB")=""
+19 SET ZTSAVE("IBEXCEL")=""
+20 DO EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"QM",1)
+21 IF POP
SET RET=0
+22 IF $GET(ZTSK)
WRITE !!,"Report compilation has started with task# ",ZTSK,".",!
SET DIR(0)="E"
DO ^DIR
KILL DIR
+23 QUIT RET
+24 ;
COMPILE(RPTNAME,DATESEL,AIB,IBEXCEL) ; Compile the report.
+1 ; RPTNAME = Report Name
+2 ; DATESEL = The earliest and latest expiration dates (format: earliest^latest).
+3 ; AIB = Active, Inactive or Both.
+4 ; IBEXCEL = 1 if user requested to display in EXCEL format; 0 otherwise.
+5 KILL ^TMP("IBNCPDRA",$JOB)
+6 IF '$DATA(ZTQUEUED)
IF 'IBEXCEL
USE 0
WRITE !,"Compiling Release of Information Expiration Report. Please wait..."
USE IO
+7 ; Collect the data
+8 DO GETDATA(DATESEL,AIB)
+9 ; Display the report
+10 DO REPORT^IBNCPDRB(RPTNAME,DATESEL,AIB,IBEXCEL)
+11 DO ^%ZISC
+12 KILL ^TMP("IBNCPDRA",$JOB)
+13 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+14 QUIT
+15 ;
GETDATA(DATES,AIB) ; Get the data from ^IBT(356.25)
+1 ; DATES = The earliest and latest expiration dates (format: earliest^latest).
+2 ; AIB = Active, Inactive or Both
+3 NEW ACTIVE,ADDED,CNT,DATE1,DATE2,D0,DOD,DPTIEN,DRUG,DRUGNAME,EFFDATE,ENTERDBY
+4 NEW EXPDATE,INS,INSNAME,PATNAME,NODE0,NODE1,STATUS,USERIEN
+5 SET DATE1=$PIECE(DATES,U)
SET DATE2=$PIECE(DATES,U,2)
+6 SET CNT=0
+7 SET D0=0
FOR
SET D0=$ORDER(^IBT(356.25,D0))
if 'D0
QUIT
Begin DoDot:1
+8 SET (DRUGNAME,ENTERDBY,INSNAME,PATNAME)=""
+9 SET CNT=CNT+1
+10 ; Write another dot after "Please wait..."
IF CNT#1000=0
IF '$DATA(ZTQUEUED)
USE 0
WRITE "."
USE IO
+11 SET NODE0=$GET(^IBT(356.25,D0,0))
SET NODE1=$GET(^IBT(356.25,D0,1))
+12 ; patient ien to ^DPT file
SET DPTIEN=$PIECE(NODE0,U,2)
+13 ; drug ien to ^PSDRUG file
SET DRUG=$PIECE(NODE0,U,3)
+14 ; insurance ien to ^DIC(36
SET INS=$PIECE(NODE0,U,4)
+15 ; effective date of ROI
SET EFFDATE=$PIECE(NODE0,U,5)
+16 ; expiration date of ROI
SET EXPDATE=$PIECE(NODE0,U,6)
+17 ; active? (0=no; 1=yes)
SET ACTIVE=$PIECE(NODE0,U,7)
+18 ; date added to ROI Claims Tracking file
SET ADDED=$PIECE(NODE1,U)
+19 ; user who added the ROI entry
SET USERIEN=$PIECE(NODE1,U,2)
+20 IF EXPDATE=""
QUIT
+21 IF EXPDATE<DATE1!(EXPDATE>DATE2)
QUIT
+22 IF AIB="I"
IF ACTIVE
QUIT
+23 IF AIB="A"
IF 'ACTIVE
QUIT
+24 IF DPTIEN'=""
SET PATNAME=$PIECE($GET(^DPT(DPTIEN,0)),U)
+25 IF PATNAME=""
QUIT
+26 ; date of death
SET DOD=$PIECE($GET(^DPT(DPTIEN,.35)),U)
+27 SET STATUS=$SELECT(ACTIVE:"A",1:"I")
+28 IF USERIEN'=""
SET ENTERDBY=$PIECE($GET(^VA(200,USERIEN,0)),U)
+29 IF ENTERDBY=""
SET ENTERDBY="UNKNOWN"
+30 IF DRUG'=""
SET DRUGNAME=$$DRUG(DRUG)
+31 IF DRUGNAME=""
SET DRUGNAME="NO DRUG NAME"
+32 IF INS'=""
SET INSNAME=$PIECE($GET(^DIC(36,INS,0)),U)
+33 IF INSNAME=""
SET INSNAME="NO INSURANCE NAME"
+34 SET ^TMP("IBNCPDRA",$JOB,EXPDATE,PATNAME,D0)=DOD_U_EFFDATE_U_STATUS_U_ADDED_U_ENTERDBY_U_INSNAME_U_DRUGNAME
End DoDot:1
+35 QUIT
+36 ; Get drug info
DRUG(DRUGIEN) ; Get drug name
+1 ; DRUGIEN = drug ien pointer
+2 NEW X
+3 KILL ^TMP($JOB,"IBNCPDRA_DRUG")
+4 ;DBIA #4533
DO DATA^PSS50(DRUGIEN,"","","","","IBNCPDRA_DRUG")
+5 SET X=$GET(^TMP($JOB,"IBNCPDRA_DRUG",DRUGIEN,.01))
+6 KILL ^TMP($JOB,"IBNCPDRA_DRUG")
+7 QUIT X
