RCDPEOP ;AITC/FA - EFT Overrride Report ;Jun 06, 2014@19:11:19
;;4.5;Accounts Receivable;**349**;Mar 20, 1995;Build 44
;Per VA Directive 6402, this routine should not be modified.
;
EN ;EP for EFT Override Report [RCDPE EFT OVERRIDE REPORT]
N %ZIS,RCDISPTY,RCDTRNG,RCHDR,RCLSTMGR,RCRPLST,RCTYPE
; RCDISPTY - display type for Excel
; RCDTRNG - Range of dates
; RCLSTMGR - ListMan flag
; RCRPLST - Node for report list in ^TMP
; RCTYPE - Payer type filter M - MEDICAL, P-PHARMACY, T-TRICARE, A-ALL
;
S RCRPLST="RCDPEOP" ; Storage for list of entries
S RCTYPE=$$RTYPE^RCDPEU1("A")
Q:RCTYPE=-1
S RCDTRNG=$$DTRNG^RCDPEM4()
Q:+RCDTRNG<1
S RCDISPTY=$$DISPTY^RCDPEM3() ; Ask if export to excel
Q:RCDISPTY<0
S RCLSTMGR="" ; Initialize
I RCDISPTY D ; Excel, set ListMan flag to prevent question
. S RCLSTMGR="^"
. D INFO^RCDPEM6
I RCLSTMGR="" D Q:RCLSTMGR<0
. S RCLSTMGR=$$ASKLM^RCDPEARL
I RCLSTMGR D Q ; Send output to ListMan
. D LMOUT(RCRPLST,RCDTRNG,RCTYPE)
;
; Ask device
S %ZIS="QM"
D ^%ZIS Q:POP
I $D(IO("Q")) D Q
. N ZTRTN,ZTSAVE,ZTDESC,POP,ZTSK
. S ZTRTN="COMPILE^RCDPEOP"
. S ZTDESC="AR - EFT Unlock Lockout Overrides"
. S ZTSAVE("RC*")=""
. D ^%ZTLOAD
. W !!,$S($G(ZTSK):"Task number "_ZTSK_" was queued.",1:"Unable to queue this task.")
. K ZTSK,IO("Q")
. D HOME^%ZIS
;
U IO
D COMPILE
D HDRBLD(RCDISPTY,RCDTRNG,RCTYPE,.RCHDR) ; Build header lines
D RPT(RCDISPTY,.RCHDR) ; Display the report
K ^TMP($J,"RCRPLST")
D ^%ZISC ; Close device
Q
;
LMOUT(RCRPLST,RCDTRNG,RCTYPE) ; Output report to Listman
; Input: RCRPLST - "RCDPEOP"
; Input: RCDTRNG - ^Start Date^End Date
; RCTYPE - 'M', 'P', 'T' or 'A'
; RCRPLST - "RCDPEOP"
; ^TMP($J,RCRPLST) - Array of data lines to be displayes
; Output: Report is displayed in Listman
N HDR
D COMPILE
S HDR("TITLE")="EFT Unlock Override Tracking"
S HDR(1)=$$HDRLN1(RCDTRNG)
S HDR(2)=$$HDRLN2(RCTYPE)
S HDR(3)=""
S HDR(4)=""
S HDR(5)=""
S HDR(6)=""
S HDR(7)=$$HDRLN3()
D LMRPT^RCDPEARL(.HDR,$NA(^TMP($J,RCRPLST))) ; Generate ListMan display
;
D ^%ZISC ; Close the device
K ^TMP(RCRPLST,$J),^TMP($J,RCRPLST)
Q
;
COMPILE ; Entry point for queued job
; Input: RCDISPTY - 1 - Display to Excel, 0 otherwise
; RCDTRNG - ^Start Date^End Date
; RCLSTMGR - ListMan flag
; RCTYPE - 'M', 'P' , 'T' or 'A'
; RCRPLST - "RCDPEOP"
; Output: ^TMP($J,RCRPLST,CT) - Array of report lines to be displayed
N CT,D1,RCCTYPE,RCHDR,RCHDT,RCHDTE,RCPGNUM,RCSTOP,RCTOT,RCRPLSTS,XX,YY,ZZ
S RCRPLSTS="RCDPEOP_SORT"
K ^TMP(RCRPLST,$J),^TMP($J,RCRPLST)
;
S (RCSTOP,RCTOT,RCTOT("M"),RCTOT("P"),RCTOT("T"),CT)=0
S RCHDT=$P(RCDTRNG,"^",2)-1,RCHDTE=$P(RCDTRNG,"^",3)+.999999
F D Q:RCSTOP
. S RCHDT=$O(^RCY(344.61,1,3,"B",RCHDT))
. I +RCHDT=0 S RCSTOP=1 Q
. I RCHDT>RCHDTE S RCSTOP=1 Q
. S D1="" F S D1=$O(^RCY(344.61,1,3,"B",RCHDT,D1)) Q:D1="" D
. . S RCCTYPE=$$GET1^DIQ(344.612,D1_",1,",.04,"I") ; Type of Override in history file
. . I RCTYPE'="A",RCTYPE'=RCCTYPE Q ; Filter out
. . D OUTLN(D1,RCDISPTY,RCHDT,RCCTYPE,RCRPLST,.CT,.RCTOT) ; Store one line in Ouput Arrays
;
; Reformat array sorted by date and counter to one sorted by line #
S RCHDT="",XX=0
F D Q:RCHDT=""
. S RCHDT=$O(^TMP(RCRPLST,$J,RCHDT))
. Q:RCHDT=""
. S CT=""
. F D Q:CT=""
. . S CT=$O(^TMP(RCRPLST,$J,RCHDT,CT))
. . Q:CT=""
. . S ZZ=^TMP(RCRPLST,$J,RCHDT,CT),XX=XX+1
. . S ^TMP($J,RCRPLST,XX)=ZZ
K ^TMP(RCRPLST,$J)
Q:RCDISPTY
;
; Add the totals at the bottom
S XX=XX+1,^TMP($J,RCRPLST,XX)=""
I RCTYPE="A"!(RCTYPE="M") D
. S YY="Total # of Medical Overrides: "_$J(RCTOT("M"),6)
. S ZZ=$$SETSTR^VALM1(YY,"",45,$L(YY))
. S XX=XX+1,^TMP($J,RCRPLST,XX)=ZZ
I RCTYPE="A"!(RCTYPE="P") D
. S YY="Total # of Pharmacy Overrides: "_$J(RCTOT("P"),5)
. S ZZ=$$SETSTR^VALM1(YY,"",45,$L(YY))
. S XX=XX+1,^TMP($J,RCRPLST,XX)=ZZ
I RCTYPE="A"!(RCTYPE="T") D
. S YY="Total # of TRICARE Overrides: "_$J(RCTOT("T"),6)
. S ZZ=$$SETSTR^VALM1(YY,"",45,$L(YY))
. S XX=XX+1,^TMP($J,RCRPLST,XX)=ZZ
I RCTYPE="A" D
. S YY="Total # of EFT Overrides: "_$J(RCTOT,10)
. S ZZ=$$SETSTR^VALM1(YY,"",45,$L(YY))
. S XX=XX+1,^TMP($J,RCRPLST,XX)=ZZ
Q
;
OUTLN(D1,RCDISPTY,RCHDT,RCCTYPE,RCRPLST,CT,TOT) ; Store one line of output into arrays
; Input: D1 - DE of sub-file 344.612 being processed
; RCDISPTY - 1 - Display to Excel, 0 otherwise
; RCHDT - Internal Date/Time of current entry being processed
; RCCTYPE - Current Override Type
; RCRPLST - "RCDPEOP"
; CT - Current line Count
; TOT - Current total # of EFT Lockout Overrides for date range
; TOT("M") - Current total # of Medical EFT LO Overrides for range
; TOT("P") - Current total # of Rx EFT LO Overrides for range
; TOT("T") - Current total # of TRICARE EFT LO Overrides for range
; ^TMP(RCRPLST,$J,RCHDT,CT) - Current Array of output display lines
; Output: CT - Updated line Count
; TOT - Updated total # of EFT Lockout Overrides for date range
; TOT("M") - Updated total # of Medical EFT LO Overrides for range
; TOT("P") - Updated total # of Rx EFT LO Overrides for range
; TOT("T") - Updated total # of TRICARE EFT LO Overrides for range
; ^TMP(RCRPLST,$J,RCHDT,CT) - Updated Array of output display lines
N LN,RCCOM,RCDYS,RCUSER,XX
S XX=$$GET1^DIQ(344.612,D1_",1,",.02,"E") ; User who performed the lockout
S RCUSER=$E($P(XX,",",1),1,4)
S RCUSER=RCUSER_","_$E($P(XX,",",2),1)
S RCCOM=$$GET1^DIQ(344.612,D1_",1,",.03) ; Lock-out Comment
S RCDYS=$$GET1^DIQ(344.612,D1_",1,",.05) ; # of lock-out days when overriden
S CT=CT+1,TOT=TOT+1
S XX=$$FMTE^XLFDT(RCHDT,"2ZD")
I RCDISPTY D Q ; Excel output
. S ^TMP(RCRPLST,$J,RCHDT,CT)=XX_"^"_RCUSER_"^"_RCCOM_"^"_RCCTYPE_"^"_RCDYS
S TOT(RCCTYPE)=TOT(RCCTYPE)+1
S LN=""
S LN=$$SETSTR^VALM1(XX,LN,1,8)
S LN=$$SETSTR^VALM1(RCUSER,LN,12,6)
S LN=$$SETSTR^VALM1(RCCOM,LN,20,50)
S LN=$$SETSTR^VALM1(RCCTYPE,LN,69,1)
S LN=$$SETSTR^VALM1($J(RCDYS,4),LN,76,4)
S ^TMP(RCRPLST,$J,RCHDT,CT)=LN
Q
;
HDRBLD(RCDISPTY,RCDTRNG,RCTYPE,RCHDR) ; Create the report header
; Input: RCDISPTY - 1 - Output to Excel, 0 otherwise
; RCDTRNG - User selected date range - ^Start Date End Date
; RCTYPE - User selected M/P/T filter - 'M', 'P' , 'T' or 'A'
; Output: RCHDR - Array of header lines to be displayed
N DIV,HCNT,HNM,XX
K RCHDR
I RCDISPTY D Q ; Excel format
. S RCHDR(1)="Date^User^Comment^Type^# Days"
;
S RCHDR=" EFT Unlock Override Tracking Report Page: "
S RCHDR(1)=$$HDRLN1(RCDTRNG)
S RCHDR(2)=$$HDRLN2(RCTYPE)
S RCHDR(3)=$$HDRLN3()
S RCHDR(4)=$TR($J("",80)," ","-")
Q
;
HDRLN1(RCDTRNG) ; Format the second header display line
; Input: RCDTRNG - User selected date range - ^Start Date End Date
; Returns: text for the first header line after the title line
N LN,XX,YY,ZZ
S YY=$$FMTE^XLFDT($P(RCDTRNG,"^",2),"2ZD") ; Start Date
S ZZ=$$FMTE^XLFDT($P(RCDTRNG,"^",3),"2ZD") ; End Date
S LN=" Date Range: "_YY_" - "_ZZ
S XX=$P($$NOW^RCDPEARL,"@",1)
S XX="Run Date: "_XX
S LN=$$SETSTR^VALM1(XX,LN,45,$L(XX))
Q LN
;
HDRLN2(RCTPYE) ; Format the second header display line
; Input: RCTYPE - User selected M/P/T filter - 'M', 'P' , 'T' or 'A'
; Returns: text for the third header line after the title line
N LN,XX
S XX=$S(RCTYPE="M":"Medical",RCTYPE="P":"Pharmacy",RCTYPE="T":"TRICARE",1:"All")
S LN=" Medical/Pharmacy/TRICARE: "_XX
Q LN
;
HDRLN3() ; Format the second header display line
Q "Date User Comment Type # Days"
;
RPT(RCDISPTY,RCHDR) ; Display/print the report using data populated in temporary global array
; Input: RCDISPTY - 1 - Output to Excel, 0 otherwise
; RCHDR - Array of header lines to be displayed
; ^TMP($J,RCRPLST) - Array of data lines to be displayed or output to excel
;
N DLINE,LN,LNCNT,PAGE,RCSTOP
S (PAGE,LNCNT,RCSTOP)=0
I '$D(^TMP($J,RCRPLST)) D Q
. D:'RCDISPTY HDRDSP(.PAGE,.LNCNT,.RCHDR,1)
. W !,$$ENDORPRT^RCDPEARL
;
D:'RCDISPTY HDRDSP(.PAGE,.LNCNT,.RCHDR)
W:RCDISPTY !,RCHDR(1)
;
S LN=""
F D Q:LN="" Q:RCSTOP
. S LN=$O(^TMP($J,RCRPLST,LN))
. Q:LN=""
. S DLINE=^TMP($J,RCRPLST,LN),LNCNT=LNCNT+1
. W:RCDISPTY !,DLINE
. Q:RCDISPTY
. I (LNCNT+2)>IOSL D HDRDSP(.PAGE,.LNCNT,.RCHDR,.RCSTOP) Q:RCSTOP
. W !,DLINE
D ASK(RCSTOP,1)
Q
;
HDRDSP(PAGE,LNCNT,RCHDR,RCSTOP) ; Display the report header
; Input: PAGE - Current page number
; LNCNT - Current line count
; RCHDR - Array of header lines to be displayed
; RCSTOP - 1 to not ask if they want to stop output
; 0 otherwise
; Output: PAGE - Updated page number
; LNCNT - Updated line count
; RCSTOP - 1 if the want to stop the output
N I
I PAGE'=0 D ASK(.RCSTOP) Q:RCSTOP
W @IOF,RCHDR
S PAGE=PAGE+1
W $J(PAGE,2)
F I=1:1:4 W !,RCHDR(I)
S LNCNT=5
Q
;
ASK(STOP,TYP) ; Ask to continue, if TYP=1 then prompt to finish
; Input: TYP - 1 - Prompt to finish, 0 Otherwise
; Output: STOP - 1 abort print, 0 otherwise
N DIR,DIROUT,DIRUT,DTOUT,DUOUT
Q:$E(IOST,1,2)'["C-" ; Not a terminal
S:$G(TYP)=1 DIR("A")="Enter RETURN to finish"
S DIR(0)="E"
W !
D ^DIR
I ($D(DIRUT))!($D(DUOUT))!($D(DUOUT)) S STOP=1
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEOP 10549 printed Sep 23, 2025@19:21:10 Page 2
RCDPEOP ;AITC/FA - EFT Overrride Report ;Jun 06, 2014@19:11:19
+1 ;;4.5;Accounts Receivable;**349**;Mar 20, 1995;Build 44
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
EN ;EP for EFT Override Report [RCDPE EFT OVERRIDE REPORT]
+1 NEW %ZIS,RCDISPTY,RCDTRNG,RCHDR,RCLSTMGR,RCRPLST,RCTYPE
+2 ; RCDISPTY - display type for Excel
+3 ; RCDTRNG - Range of dates
+4 ; RCLSTMGR - ListMan flag
+5 ; RCRPLST - Node for report list in ^TMP
+6 ; RCTYPE - Payer type filter M - MEDICAL, P-PHARMACY, T-TRICARE, A-ALL
+7 ;
+8 ; Storage for list of entries
SET RCRPLST="RCDPEOP"
+9 SET RCTYPE=$$RTYPE^RCDPEU1("A")
+10 if RCTYPE=-1
QUIT
+11 SET RCDTRNG=$$DTRNG^RCDPEM4()
+12 if +RCDTRNG<1
QUIT
+13 ; Ask if export to excel
SET RCDISPTY=$$DISPTY^RCDPEM3()
+14 if RCDISPTY<0
QUIT
+15 ; Initialize
SET RCLSTMGR=""
+16 ; Excel, set ListMan flag to prevent question
IF RCDISPTY
Begin DoDot:1
+17 SET RCLSTMGR="^"
+18 DO INFO^RCDPEM6
End DoDot:1
+19 IF RCLSTMGR=""
Begin DoDot:1
+20 SET RCLSTMGR=$$ASKLM^RCDPEARL
End DoDot:1
if RCLSTMGR<0
QUIT
+21 ; Send output to ListMan
IF RCLSTMGR
Begin DoDot:1
+22 DO LMOUT(RCRPLST,RCDTRNG,RCTYPE)
End DoDot:1
QUIT
+23 ;
+24 ; Ask device
+25 SET %ZIS="QM"
+26 DO ^%ZIS
if POP
QUIT
+27 IF $DATA(IO("Q"))
Begin DoDot:1
+28 NEW ZTRTN,ZTSAVE,ZTDESC,POP,ZTSK
+29 SET ZTRTN="COMPILE^RCDPEOP"
+30 SET ZTDESC="AR - EFT Unlock Lockout Overrides"
+31 SET ZTSAVE("RC*")=""
+32 DO ^%ZTLOAD
+33 WRITE !!,$SELECT($GET(ZTSK):"Task number "_ZTSK_" was queued.",1:"Unable to queue this task.")
+34 KILL ZTSK,IO("Q")
+35 DO HOME^%ZIS
End DoDot:1
QUIT
+36 ;
+37 USE IO
+38 DO COMPILE
+39 ; Build header lines
DO HDRBLD(RCDISPTY,RCDTRNG,RCTYPE,.RCHDR)
+40 ; Display the report
DO RPT(RCDISPTY,.RCHDR)
+41 KILL ^TMP($JOB,"RCRPLST")
+42 ; Close device
DO ^%ZISC
+43 QUIT
+44 ;
LMOUT(RCRPLST,RCDTRNG,RCTYPE) ; Output report to Listman
+1 ; Input: RCRPLST - "RCDPEOP"
+2 ; Input: RCDTRNG - ^Start Date^End Date
+3 ; RCTYPE - 'M', 'P', 'T' or 'A'
+4 ; RCRPLST - "RCDPEOP"
+5 ; ^TMP($J,RCRPLST) - Array of data lines to be displayes
+6 ; Output: Report is displayed in Listman
+7 NEW HDR
+8 DO COMPILE
+9 SET HDR("TITLE")="EFT Unlock Override Tracking"
+10 SET HDR(1)=$$HDRLN1(RCDTRNG)
+11 SET HDR(2)=$$HDRLN2(RCTYPE)
+12 SET HDR(3)=""
+13 SET HDR(4)=""
+14 SET HDR(5)=""
+15 SET HDR(6)=""
+16 SET HDR(7)=$$HDRLN3()
+17 ; Generate ListMan display
DO LMRPT^RCDPEARL(.HDR,$NAME(^TMP($JOB,RCRPLST)))
+18 ;
+19 ; Close the device
DO ^%ZISC
+20 KILL ^TMP(RCRPLST,$JOB),^TMP($JOB,RCRPLST)
+21 QUIT
+22 ;
COMPILE ; Entry point for queued job
+1 ; Input: RCDISPTY - 1 - Display to Excel, 0 otherwise
+2 ; RCDTRNG - ^Start Date^End Date
+3 ; RCLSTMGR - ListMan flag
+4 ; RCTYPE - 'M', 'P' , 'T' or 'A'
+5 ; RCRPLST - "RCDPEOP"
+6 ; Output: ^TMP($J,RCRPLST,CT) - Array of report lines to be displayed
+7 NEW CT,D1,RCCTYPE,RCHDR,RCHDT,RCHDTE,RCPGNUM,RCSTOP,RCTOT,RCRPLSTS,XX,YY,ZZ
+8 SET RCRPLSTS="RCDPEOP_SORT"
+9 KILL ^TMP(RCRPLST,$JOB),^TMP($JOB,RCRPLST)
+10 ;
+11 SET (RCSTOP,RCTOT,RCTOT("M"),RCTOT("P"),RCTOT("T"),CT)=0
+12 SET RCHDT=$PIECE(RCDTRNG,"^",2)-1
SET RCHDTE=$PIECE(RCDTRNG,"^",3)+.999999
+13 FOR
Begin DoDot:1
+14 SET RCHDT=$ORDER(^RCY(344.61,1,3,"B",RCHDT))
+15 IF +RCHDT=0
SET RCSTOP=1
QUIT
+16 IF RCHDT>RCHDTE
SET RCSTOP=1
QUIT
+17 SET D1=""
FOR
SET D1=$ORDER(^RCY(344.61,1,3,"B",RCHDT,D1))
if D1=""
QUIT
Begin DoDot:2
+18 ; Type of Override in history file
SET RCCTYPE=$$GET1^DIQ(344.612,D1_",1,",.04,"I")
+19 ; Filter out
IF RCTYPE'="A"
IF RCTYPE'=RCCTYPE
QUIT
+20 ; Store one line in Ouput Arrays
DO OUTLN(D1,RCDISPTY,RCHDT,RCCTYPE,RCRPLST,.CT,.RCTOT)
End DoDot:2
End DoDot:1
if RCSTOP
QUIT
+21 ;
+22 ; Reformat array sorted by date and counter to one sorted by line #
+23 SET RCHDT=""
SET XX=0
+24 FOR
Begin DoDot:1
+25 SET RCHDT=$ORDER(^TMP(RCRPLST,$JOB,RCHDT))
+26 if RCHDT=""
QUIT
+27 SET CT=""
+28 FOR
Begin DoDot:2
+29 SET CT=$ORDER(^TMP(RCRPLST,$JOB,RCHDT,CT))
+30 if CT=""
QUIT
+31 SET ZZ=^TMP(RCRPLST,$JOB,RCHDT,CT)
SET XX=XX+1
+32 SET ^TMP($JOB,RCRPLST,XX)=ZZ
End DoDot:2
if CT=""
QUIT
End DoDot:1
if RCHDT=""
QUIT
+33 KILL ^TMP(RCRPLST,$JOB)
+34 if RCDISPTY
QUIT
+35 ;
+36 ; Add the totals at the bottom
+37 SET XX=XX+1
SET ^TMP($JOB,RCRPLST,XX)=""
+38 IF RCTYPE="A"!(RCTYPE="M")
Begin DoDot:1
+39 SET YY="Total # of Medical Overrides: "_$JUSTIFY(RCTOT("M"),6)
+40 SET ZZ=$$SETSTR^VALM1(YY,"",45,$LENGTH(YY))
+41 SET XX=XX+1
SET ^TMP($JOB,RCRPLST,XX)=ZZ
End DoDot:1
+42 IF RCTYPE="A"!(RCTYPE="P")
Begin DoDot:1
+43 SET YY="Total # of Pharmacy Overrides: "_$JUSTIFY(RCTOT("P"),5)
+44 SET ZZ=$$SETSTR^VALM1(YY,"",45,$LENGTH(YY))
+45 SET XX=XX+1
SET ^TMP($JOB,RCRPLST,XX)=ZZ
End DoDot:1
+46 IF RCTYPE="A"!(RCTYPE="T")
Begin DoDot:1
+47 SET YY="Total # of TRICARE Overrides: "_$JUSTIFY(RCTOT("T"),6)
+48 SET ZZ=$$SETSTR^VALM1(YY,"",45,$LENGTH(YY))
+49 SET XX=XX+1
SET ^TMP($JOB,RCRPLST,XX)=ZZ
End DoDot:1
+50 IF RCTYPE="A"
Begin DoDot:1
+51 SET YY="Total # of EFT Overrides: "_$JUSTIFY(RCTOT,10)
+52 SET ZZ=$$SETSTR^VALM1(YY,"",45,$LENGTH(YY))
+53 SET XX=XX+1
SET ^TMP($JOB,RCRPLST,XX)=ZZ
End DoDot:1
+54 QUIT
+55 ;
OUTLN(D1,RCDISPTY,RCHDT,RCCTYPE,RCRPLST,CT,TOT) ; Store one line of output into arrays
+1 ; Input: D1 - DE of sub-file 344.612 being processed
+2 ; RCDISPTY - 1 - Display to Excel, 0 otherwise
+3 ; RCHDT - Internal Date/Time of current entry being processed
+4 ; RCCTYPE - Current Override Type
+5 ; RCRPLST - "RCDPEOP"
+6 ; CT - Current line Count
+7 ; TOT - Current total # of EFT Lockout Overrides for date range
+8 ; TOT("M") - Current total # of Medical EFT LO Overrides for range
+9 ; TOT("P") - Current total # of Rx EFT LO Overrides for range
+10 ; TOT("T") - Current total # of TRICARE EFT LO Overrides for range
+11 ; ^TMP(RCRPLST,$J,RCHDT,CT) - Current Array of output display lines
+12 ; Output: CT - Updated line Count
+13 ; TOT - Updated total # of EFT Lockout Overrides for date range
+14 ; TOT("M") - Updated total # of Medical EFT LO Overrides for range
+15 ; TOT("P") - Updated total # of Rx EFT LO Overrides for range
+16 ; TOT("T") - Updated total # of TRICARE EFT LO Overrides for range
+17 ; ^TMP(RCRPLST,$J,RCHDT,CT) - Updated Array of output display lines
+18 NEW LN,RCCOM,RCDYS,RCUSER,XX
+19 ; User who performed the lockout
SET XX=$$GET1^DIQ(344.612,D1_",1,",.02,"E")
+20 SET RCUSER=$EXTRACT($PIECE(XX,",",1),1,4)
+21 SET RCUSER=RCUSER_","_$EXTRACT($PIECE(XX,",",2),1)
+22 ; Lock-out Comment
SET RCCOM=$$GET1^DIQ(344.612,D1_",1,",.03)
+23 ; # of lock-out days when overriden
SET RCDYS=$$GET1^DIQ(344.612,D1_",1,",.05)
+24 SET CT=CT+1
SET TOT=TOT+1
+25 SET XX=$$FMTE^XLFDT(RCHDT,"2ZD")
+26 ; Excel output
IF RCDISPTY
Begin DoDot:1
+27 SET ^TMP(RCRPLST,$JOB,RCHDT,CT)=XX_"^"_RCUSER_"^"_RCCOM_"^"_RCCTYPE_"^"_RCDYS
End DoDot:1
QUIT
+28 SET TOT(RCCTYPE)=TOT(RCCTYPE)+1
+29 SET LN=""
+30 SET LN=$$SETSTR^VALM1(XX,LN,1,8)
+31 SET LN=$$SETSTR^VALM1(RCUSER,LN,12,6)
+32 SET LN=$$SETSTR^VALM1(RCCOM,LN,20,50)
+33 SET LN=$$SETSTR^VALM1(RCCTYPE,LN,69,1)
+34 SET LN=$$SETSTR^VALM1($JUSTIFY(RCDYS,4),LN,76,4)
+35 SET ^TMP(RCRPLST,$JOB,RCHDT,CT)=LN
+36 QUIT
+37 ;
HDRBLD(RCDISPTY,RCDTRNG,RCTYPE,RCHDR) ; Create the report header
+1 ; Input: RCDISPTY - 1 - Output to Excel, 0 otherwise
+2 ; RCDTRNG - User selected date range - ^Start Date End Date
+3 ; RCTYPE - User selected M/P/T filter - 'M', 'P' , 'T' or 'A'
+4 ; Output: RCHDR - Array of header lines to be displayed
+5 NEW DIV,HCNT,HNM,XX
+6 KILL RCHDR
+7 ; Excel format
IF RCDISPTY
Begin DoDot:1
+8 SET RCHDR(1)="Date^User^Comment^Type^# Days"
End DoDot:1
QUIT
+9 ;
+10 SET RCHDR=" EFT Unlock Override Tracking Report Page: "
+11 SET RCHDR(1)=$$HDRLN1(RCDTRNG)
+12 SET RCHDR(2)=$$HDRLN2(RCTYPE)
+13 SET RCHDR(3)=$$HDRLN3()
+14 SET RCHDR(4)=$TRANSLATE($JUSTIFY("",80)," ","-")
+15 QUIT
+16 ;
HDRLN1(RCDTRNG) ; Format the second header display line
+1 ; Input: RCDTRNG - User selected date range - ^Start Date End Date
+2 ; Returns: text for the first header line after the title line
+3 NEW LN,XX,YY,ZZ
+4 ; Start Date
SET YY=$$FMTE^XLFDT($PIECE(RCDTRNG,"^",2),"2ZD")
+5 ; End Date
SET ZZ=$$FMTE^XLFDT($PIECE(RCDTRNG,"^",3),"2ZD")
+6 SET LN=" Date Range: "_YY_" - "_ZZ
+7 SET XX=$PIECE($$NOW^RCDPEARL,"@",1)
+8 SET XX="Run Date: "_XX
+9 SET LN=$$SETSTR^VALM1(XX,LN,45,$LENGTH(XX))
+10 QUIT LN
+11 ;
HDRLN2(RCTPYE) ; Format the second header display line
+1 ; Input: RCTYPE - User selected M/P/T filter - 'M', 'P' , 'T' or 'A'
+2 ; Returns: text for the third header line after the title line
+3 NEW LN,XX
+4 SET XX=$SELECT(RCTYPE="M":"Medical",RCTYPE="P":"Pharmacy",RCTYPE="T":"TRICARE",1:"All")
+5 SET LN=" Medical/Pharmacy/TRICARE: "_XX
+6 QUIT LN
+7 ;
HDRLN3() ; Format the second header display line
+1 QUIT "Date User Comment Type # Days"
+2 ;
RPT(RCDISPTY,RCHDR) ; Display/print the report using data populated in temporary global array
+1 ; Input: RCDISPTY - 1 - Output to Excel, 0 otherwise
+2 ; RCHDR - Array of header lines to be displayed
+3 ; ^TMP($J,RCRPLST) - Array of data lines to be displayed or output to excel
+4 ;
+5 NEW DLINE,LN,LNCNT,PAGE,RCSTOP
+6 SET (PAGE,LNCNT,RCSTOP)=0
+7 IF '$DATA(^TMP($JOB,RCRPLST))
Begin DoDot:1
+8 if 'RCDISPTY
DO HDRDSP(.PAGE,.LNCNT,.RCHDR,1)
+9 WRITE !,$$ENDORPRT^RCDPEARL
End DoDot:1
QUIT
+10 ;
+11 if 'RCDISPTY
DO HDRDSP(.PAGE,.LNCNT,.RCHDR)
+12 if RCDISPTY
WRITE !,RCHDR(1)
+13 ;
+14 SET LN=""
+15 FOR
Begin DoDot:1
+16 SET LN=$ORDER(^TMP($JOB,RCRPLST,LN))
+17 if LN=""
QUIT
+18 SET DLINE=^TMP($JOB,RCRPLST,LN)
SET LNCNT=LNCNT+1
+19 if RCDISPTY
WRITE !,DLINE
+20 if RCDISPTY
QUIT
+21 IF (LNCNT+2)>IOSL
DO HDRDSP(.PAGE,.LNCNT,.RCHDR,.RCSTOP)
if RCSTOP
QUIT
+22 WRITE !,DLINE
End DoDot:1
if LN=""
QUIT
if RCSTOP
QUIT
+23 DO ASK(RCSTOP,1)
+24 QUIT
+25 ;
HDRDSP(PAGE,LNCNT,RCHDR,RCSTOP) ; Display the report header
+1 ; Input: PAGE - Current page number
+2 ; LNCNT - Current line count
+3 ; RCHDR - Array of header lines to be displayed
+4 ; RCSTOP - 1 to not ask if they want to stop output
+5 ; 0 otherwise
+6 ; Output: PAGE - Updated page number
+7 ; LNCNT - Updated line count
+8 ; RCSTOP - 1 if the want to stop the output
+9 NEW I
+10 IF PAGE'=0
DO ASK(.RCSTOP)
if RCSTOP
QUIT
+11 WRITE @IOF,RCHDR
+12 SET PAGE=PAGE+1
+13 WRITE $JUSTIFY(PAGE,2)
+14 FOR I=1:1:4
WRITE !,RCHDR(I)
+15 SET LNCNT=5
+16 QUIT
+17 ;
ASK(STOP,TYP) ; Ask to continue, if TYP=1 then prompt to finish
+1 ; Input: TYP - 1 - Prompt to finish, 0 Otherwise
+2 ; Output: STOP - 1 abort print, 0 otherwise
+3 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT
+4 ; Not a terminal
if $EXTRACT(IOST,1,2)'["C-"
QUIT
+5 if $GET(TYP)=1
SET DIR("A")="Enter RETURN to finish"
+6 SET DIR(0)="E"
+7 WRITE !
+8 DO ^DIR
+9 IF ($DATA(DIRUT))!($DATA(DUOUT))!($DATA(DUOUT))
SET STOP=1
+10 QUIT
+11 ;
