- 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 Jan 18, 2025@02:46:20 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 ;