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

RCDPRSEA.m

Go to the documentation of this file. 
  1. RCDPRSEA ;WISC/RFJ,PJH,hrub - extended search ;4 Feb 2019 09:24:27
  1.  ;;4.5;Accounts Receivable;**114,148,208,269,304,332,345**;Mar 20, 1995;Build 34
  1.  ;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; enter at top for [RCDP EXTENDED CHECK/CC SEARCH] option
  1.  N DATEEND,DATESTRT,RCDUP,RCPAYTYP,RCRPRT,RCRTRN,RCSRCH,RCTRGT,X,Y
  1.  ;
  1.  ; search check, credit card, trace #, or All
  1.  W !!,"Extended AR BATCH PAYMENT file search.",!
  1.  S RCSRCH=$$ASKSEA I RCSRCH<1 Q
  1.  ;
  1.  S RCTRGT("Any#")=U F X=1,2,3 S RCTRGT($$SBSCRPT(X))=U  ; initialize all search targets
  1.  ; check # to search for
  1.  I RCSRCH=1 S RCTRGT("Check#")=$$ASKCHEK^RCDPLPL1 I RCTRGT("Check#")=-1 Q
  1.  ; credit card to search for
  1.  I RCSRCH=2 S RCTRGT("CredCard")=$$ASKCRED^RCDPLPL1 I RCTRGT("CredCard")=-1 Q
  1.  ; trace # to search for
  1.  I RCSRCH=3 S RCTRGT("Trace#")=$$ASKTRACE^RCDPLPL1 I RCTRGT("Trace#")=-1 Q
  1.  I RCSRCH=4 D  I RCTRGT("Any#")=U Q
  1.  . S RCTRGT("Any#")=$$ASK4ALL Q:RCTRGT("Any#")=U
  1.  . S (RCTRGT("Check#"),RCTRGT("CredCard"),RCTRGT("Trace#"))=RCTRGT("Any#")  ; for all 3 types of search
  1.  ; ask contains or equals
  1.  S RCSRCH("type")=$$ASKTYPE^RCDPLPL1 I RCSRCH("type")=-1 Q
  1.  S RCSRCH("type")=$E(RCSRCH("type"))  ; will be "E" or "C"
  1.  S RCDUP=0
  1.  I (RCSRCH=3!(RCSRCH=4))&($L($G(RCTRGT("Trace#")))>44) D  I RCDUP=-1 Q
  1.  . S RCDUP=$$ASKDUP()
  1.  ;
  1.  ; ask receipt open dates
  1.  W ! D DATESEL^RCRJRTRA("RECEIPT Opened")
  1.  I '$G(DATESTRT)!('$G(DATEEND)) Q
  1.  ;
  1.  F X=1,2,3 S RCTRGT($$SBSCRPT(X))=$$UP(RCTRGT($$SBSCRPT(X))) ; case-insensitive search
  1.  S RCSRCH("FromDt")=DATESTRT\1,RCSRCH("ToDt")=DATEEND\1  ; start/end dates without time
  1.  S RCRPRT("HdrFrom")=$$FMTE^XLFDT(RCSRCH("FromDt")),RCRPRT("HdrTo")=$$FMTE^XLFDT(RCSRCH("ToDt"))
  1.  ; select device
  1.  W ! N %ZIS S %ZIS="Q" D ^%ZIS I POP Q
  1.  I $D(IO("Q")) D  Q
  1.  . N ZTDESC,ZTQUEUED,ZTRTN,ZTSAVE,ZTSK
  1.  . S ZTDESC="Extended Check/Trace#/Credit Card Search"
  1.  . S ZTSAVE("RC*")="",ZTSAVE("ZTREQ")="@",ZTRTN="DQ^"_$T(+0)
  1.  . D ^%ZTLOAD
  1.  . W !!,$S($G(ZTSK):"Report queued as task #"_ZTSK,1:"Unable to queue this report.")
  1.  . K IO("Q")
  1.  ; from here on for interactive user only
  1.  F  D  Q:RCSRCH("Exit")  ; loop here if no results found
  1.  . D DQ I RCSRCH("Cntr")!RCSRCH("Exit") S RCSRCH("Exit")=1 Q  ; results returned or exit indicated
  1.  . I RCSRCH=4 S RCSRCH("Exit")=1 Q  ; 'All' was selected, don't ask, exit
  1.  . S RCSRCH("PrevType")=RCSRCH  ; save for user interaction
  1.  . S RCSRCH("Exit")='$$ASK2CONT Q:RCSRCH("Exit")
  1.  . F  D  Q:'$L(RCSRCH("PrevType"))!RCSRCH("Exit")
  1.  ..  S RCSRCH("NewType")=$$ASKSEA I RCSRCH("NewType")<1 S RCSRCH("Exit")=1 Q
  1.  ..  I RCSRCH("NewType")=RCSRCH("PrevType") D  Q
  1.  ...   N DIR,DTOUT,DUOUT,X,Y
  1.  ...   S DIR(0)="EA",DIR("A")="Press ENTER to continue, '^' to exit: "
  1.  ...   S DIR("A",1)=" ",DIR("A",2)="That was the previous search type."
  1.  ...   S DIR("A",3)="Please select another type of search." D ^DIR
  1.  ...   S RCSRCH("Exit")=$S(X[U!$D(DUOUT)!$D(DTOUT):1,1:0)
  1.  ..  Q:RCSRCH("Exit")
  1.  ..  F X=1,2,3 S RCTRGT($$SBSCRPT(X))=U  ; re-initialize all search targets
  1.  ..  S RCSRCH=RCSRCH("NewType"),RCSRCH("PrevType")=""  ; set previous type to null to exit loop
  1.  ..  S RCTRGT($$SBSCRPT(RCSRCH))=RCSRCH("PrevTrgt")
  1.  ..  I RCSRCH=4 F X=1,2,3 S RCTRGT($$SBSCRPT(X))=RCSRCH("PrevTrgt")  ; if new search is ALL
  1.  ;
  1.  Q
  1.  ;
  1. DQ ; entry from TaskMan or from above
  1.  N A,B,J,RCACCNT,RCBTCH,RCPAYTYP,RCTRANS,RCTRCNUM,RCXREFDT,X,Y
  1.  ; print report
  1.  S RCRPRT("HdrTime")=$$FMTE^XLFDT($$NOW^XLFDT)  ; NOW in external format
  1.  S RCRPRT("HdrPage#")=1,RCSRCH("Exit")=0,RCSRCH("Cntr")=0  ; page number, exit flag, found count
  1.  ; save target for additional searches
  1.  S RCSRCH("PrevTrgt")=RCTRGT($$SBSCRPT(RCSRCH))
  1.  U IO D H
  1.  S RCXREFDT=RCSRCH("ToDt")+.5  ; initialize to last date plus a fraction, "AO" index has time
  1.  F  S RCXREFDT=$O(^RCY(344,"AO",RCXREFDT),-1) Q:'RCXREFDT!(RCXREFDT<RCSRCH("FromDt"))  D CHKTRANS(RCXREFDT)
  1.  ;
  1.  W:'$G(RCSRCH("Exit")) !!,"Total records found: "_$FN(RCSRCH("Cntr"),",")
  1.  I '($E(IOST,1,2)="C-")!$G(ZTSK) S RCSRCH("Exit")=1  ; continue only if interactive user
  1.  U IO(0) D ^%ZISC
  1.  Q:RCSRCH("Exit")
  1.  D  ; ask user to press ENTER if no '^'
  1.  . N DIR S DIR(0)="EA",DIR("A")="Search Finished. Press ENTER to continue: ",DIR("A",1)=" " D ^DIR
  1.  Q
  1.  ;
  1. CHKTRANS(RCXREFDT) ; check TRANSACTION multiple on date RCXREFDT
  1.  S RCBTCH=0  ; IEN in AR BATCH PAYMENT file (#344)
  1.  F  S RCBTCH=$O(^RCY(344,"AO",RCXREFDT,RCBTCH)) Q:'RCBTCH!($G(RCSRCH("Exit")))  D
  1.  . S RCBTCH(0)=$G(^RCY(344,RCBTCH,0))
  1.  . S RCTRANS=0  ; ^RCY(344,D0,1,0)=^344.01AI^^  (#1) TRANSACTION
  1.  . F  S RCTRANS=$O(^RCY(344,RCBTCH,1,RCTRANS)) Q:'RCTRANS!($G(RCSRCH("Exit")))  D
  1.  ..  I $E(IOST,1,2)="C-" R X:0 I X[U S RCSRCH("Exit")=1 Q  ; exit if user types '^' during search
  1.  ..  S RCTRANS(0)=$G(^RCY(344,RCBTCH,1,RCTRANS,0))
  1.  ..  ;  check # search
  1.  ..  I RCSRCH=1!(RCSRCH=4) D  Q:RCSRCH<4
  1.  ...   S X=$P(RCTRANS(0),U,7) Q:X=""
  1.  ...   I RCSRCH("type")="E" Q:$$UP(X)'=RCTRGT("Check#")  ;equals
  1.  ...   I $$UP(X)'[RCTRGT("Check#") Q                     ;contains
  1.  ...   D DISPLAY(1,X) S RCSRCH("Cntr")=RCSRCH("Cntr")+1
  1.  ..  ;  trace # search
  1.  ..  I RCSRCH=3!(RCSRCH=4) D  Q:RCSRCH<4
  1.  ...   S RCTRCNUM=$$UP($$TRACE(RCBTCH(0))) Q:RCTRCNUM=""
  1.  ...   I '$$CHKTRACE(RCSRCH("type"),RCTRCNUM,RCTRGT("Trace#"),RCDUP) Q
  1.  ...   D DISPLAY(3,RCTRCNUM) S RCSRCH("Cntr")=RCSRCH("Cntr")+1
  1.  ..  ; fall through to credit card # search
  1.  ..  Q:'((RCSRCH=2)!(RCSRCH=4))
  1.  ..  S X=$P(RCTRANS(0),U,11) Q:X=""
  1.  ..  I RCSRCH("type")="E" Q:X'=RCTRGT("CredCard")  ;equals
  1.  ..  I X'[RCTRGT("CredCard") Q                     ;contains
  1.  ..  D DISPLAY(2,X) S RCSRCH("Cntr")=RCSRCH("Cntr")+1
  1.  ;
  1.  Q
  1.  ;
  1. DISPLAY(RCPAYTYP,RCITMFND) ;  display the payment
  1.  ; RCPAYTYP - 1:check #, 2: credit card, 3:trace #
  1.  ; RCITMFND - value found
  1.  Q:$G(RCSRCH("Exit"))  ; exit flag
  1.  ; handle display to screen
  1.  I $E(IOST,1,2)="C-",$Y>(IOSL-6) D  Q:RCSRCH("Exit")
  1.  . S RCSRCH("Exit")=0
  1.  . N DIR,X,Y
  1.  . S DIR(0)="EA",DIR("A")="Press ENTER to continue, '^' to exit: " D ^DIR
  1.  . S RCSRCH("Exit")=$S(X[U!$D(DUOUT)!$D(DTOUT):1,1:0)
  1.  . Q:RCSRCH("Exit")  ; user indicated to stop
  1.  . D H
  1.  ; next line for non-interactive device
  1.  I '($E(IOST,1,2)="C-"),$Y>(IOSL-2) D H
  1.  ; receipt
  1.  S J=$P(RCBTCH(0),U),A=$P(RCBTCH(0),U,3)  ; A is the date opened
  1.  S J=J_$J(" ",15-$L(J))_$E(A,4,5)_"/"_$E(A,6,7)_"/"_$E(A,2,3)  ; format date opened
  1.  S J=J_$J(" ",27-$L(J))_RCTRANS  ; add transaction number
  1.  ; account
  1.  S RCACCNT("Pntr")=$P(RCTRANS(0),U,3),RCACCNT=" -"
  1.  I RCACCNT("Pntr")["PRCA(430," S RCACCNT=$P($G(^PRCA(430,+RCACCNT("Pntr"),0)),U)
  1.  I RCACCNT("Pntr")["DPT(" S RCACCNT=$P($G(^DPT(+RCACCNT("Pntr"),0)),U)
  1.  S J=J_$J(" ",31-$L(J))_RCACCNT  ; add account
  1.  S J=J_$J(" ",55-$L(J))_"$"_$J($P(RCTRANS(0),U,4),8,2)  ; add amount
  1.  W !,J
  1.  ;  check/trace/credit card number
  1.  S J=RCITMFND
  1.  ; if search all types, indicate what was found
  1.  I RCSRCH=4 S J=J_"   ("_$S(RCPAYTYP=1:"Check #",RCPAYTYP=2:"Credit Card",1:"Trace #")_")"
  1.  W !,"   "_J
  1.  Q
  1.  ;
  1. H ;  header
  1.  S A=RCRPRT("HdrTime")_" Page: "_RCRPRT("HdrPage#"),RCRPRT("HdrPage#")=RCRPRT("HdrPage#")+1
  1.  S B="Extended Check #/Trace #/Credit Card Search",$E(B,80-$L(A)+1,80)=A
  1.  W @IOF,B
  1.  W !,"  For the Date Range: "_RCRPRT("HdrFrom")_"  to  "_RCRPRT("HdrTo")
  1.  S B="       Searching for: "_$S(RCSRCH=1:"CHECK ",RCSRCH=2:"CREDIT CARD ",RCSRCH=3:"TRACE # ",1:"ALL TYPES")
  1.  S B=B_$S(RCSRCH("type")="E":" EQUAL",1:" CONTAIN")_$S(RCSRCH<4:"S",1:"ING")_" " ; handle plurals
  1.  S B=B_$C(34)_RCTRGT($$SBSCRPT(RCSRCH))_$C(34)
  1.  W !,B
  1.  W !,"Receipt       Open Date  Trans  Account                   Amount"
  1.  W !,"   "_$S(RCSRCH=1:"Check #",RCSRCH=2:"Credit Card #",RCSRCH=3:"Trace #",1:"Any #")
  1.  W !,$TR($J(" ",80)," ","=")  ; 80 equal signs
  1.  Q
  1.  ;
  1. TRACE(RC344ZRO) ; Return trace # for receipt, RC344ZRO - zero node from file #344
  1.  N P
  1.  S P=+$P(RC344ZRO,U,18) I P Q $P($G(^RCY(344.4,P,0)),U,2)  ; (#.18) ERA REFERENCE [18P:344.4] > 344.4,(#.02) TRACE NUMBER [2F]
  1.  S P=+$P(RC344ZRO,U,17) I P Q $P($G(^RCY(344.31,P,0)),U,4)  ; (#.17) EFT RECORD [17P:344.31] > 344.31,(#.04) TRACE # [4F]
  1.  Q ""  ; no trace # found
  1.  ;
  1. ASKSEA() ;  ask search field
  1.  N DIR,DIRUT,DTOUT,DUOUT,X,Y
  1.  S DIR(0)="SAO^1:Check;2:Credit Card;3:Trace #;4:All"
  1.  S DIR("A")="Search for Check, Trace, Credit Card #, or All: "
  1.  S DIR("B")="All"
  1.  D ^DIR
  1.  I $G(DTOUT)!($G(DUOUT)) S Y=-1
  1.  Q Y
  1.  ;
  1. ASK4ALL() ; Ask the ePayments trace value for ALL types, returns '^' on null or timeout
  1.  N DIR,X,Y
  1.  S DIR(0)="FAO^3:50"
  1.  S DIR("A",1)="Enter the check, credit card, or trace number to Search for"
  1.   S DIR("A")="in All types: "
  1.  S DIR("?")="Enter a search number, 3 to 50 characters free text."
  1.  D ^DIR
  1.  I $G(DTOUT)!($G(DUOUT)) S Y=U
  1.  Q $S(Y'="":$$UP(Y),1:U)
  1.  ;
  1. ASK2CONT() ; Boolean function, ask user if they want to search again
  1.  ; returns 1 if user wants a new search, else zero
  1.  N DIR,DTOUT,DUOUT,X,Y
  1.  S RCRTRN=0,DIR(0)="YA",DIR("A")="Would you like to perform another search? "
  1.  S DIR("A",1)=" "
  1.  S DIR("A",2)="You can search for "_$C(34)_RCTRGT($$SBSCRPT(RCSRCH("PrevType")))_$C(34)_" in another kind of search."
  1.  S DIR("A",3)=" "
  1.  S DIR("?")="Enter 'YES' to search again using the same ePayments values.",DIR("B")="NO"
  1.  D ^DIR
  1.  Q $S(X[U!$D(DUOUT)!$D(DTOUT)!'Y:0,1:1)
  1.  ;
  1. ASKDUP() ; Boolean function, ask user if they wish to include trace numbers ending in "-DUPn"
  1.  ; returns 1 if user wants to include duplicate trace#, else zero
  1.  N DIR,DTOUT,DUOUT,X,Y
  1.  S RCRTRN=0,DIR(0)="YA",DIR("A")="Include Duplicate Trace#s: "
  1.  S DIR("A",1)="If a trace number is greater than 45 characters and a duplicated ERA is"
  1.  S DIR("A",2)="received, the trace number may be shortened, so that -DUP can be added"
  1.  S DIR("A",3)="to the end.  Answering yes, will cause these trace numbers to be included"
  1.  S DIR("A",4)="in the search results."
  1.  S DIR("A",5)=" "
  1.  S DIR("?")="Enter 'YES' to include duplicate trace numbers.",DIR("B")="NO" D ^DIR
  1.  Q $S(X[U!$D(DUOUT)!$D(DTOUT):-1,1:+Y)
  1.  ;
  1. CHKTRACE(TYPE,TRACE,TARGET,DUP) ; Check if Trace# is a match
  1.  ; Input: TYPE - Type of search E=equals, C=CONTAINS
  1.  ;        TRACE - TRACE# from receipt
  1.  ;        TARGET - String user is searching for
  1.  ;        DUP - 1 - include duplicates, otherwise 0.
  1.  ; Output: 1 - trace number matches the target, otherwise 0.
  1.  ;
  1.  N FOUND,X
  1.  I TYPE="E",TRACE=TARGET Q 1 ;equals
  1.  I TYPE="C",TRACE[TARGET Q 1 ;contains
  1.  I RCDUP S FOUND=0 D  I FOUND Q 1 ; Include duplicates
  1.  . I TRACE'["-DUP" Q  ; not a duplicate
  1.  . S X=$P(TRACE,"-DUP",1)
  1.  . I TYPE="E",X=$E(TARGET,1,$L(X)) S FOUND=1
  1.  . I TYPE="C",X[$E(TARGET,1,$L(X)) S FOUND=1
  1.  Q 0
  1.  ;
  1.  ; return subscript for search type, if type is 4 all search targets are the same
  1. SBSCRPT(X) Q $S(X=1:"Check#",X=2:"CredCard",1:"Trace#")
  1.  ; function, uppercase
  1. UP(T) Q $TR(T,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  1.  ;