Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCDPEOP

RCDPEOP.m

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