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

RCDPCRR.m

Go to the documentation of this file.
  1. RCDPCRR ;ALB/TJB - CARC/RARC DATA TABLE REPORT ;11/03/14 1:00pm
  1. ;;4.5;Accounts Receivable;**303**;Mar 20, 1995;Build 84
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. Q
  1. ; PRCA*4.5*303 - CARC/RARC DATA Table report
  1. ;
  1. ; DESCRIPTION : The following generates a report that displays selected or all
  1. ; CARC or RARC Codes from the Files 345 (CARC) or 346 (RARC).
  1. ; several filters may be used to limit the codes displayed:
  1. ; * CARCs only, RARCs only or Both - default is both.
  1. ; * Display Active, Inactive or Both - default is active
  1. ; * Report Date - default today
  1. ; * Output to excel (Yes/No) - default is no
  1. ;
  1. ; INPUTS : The user is prompted for the following:
  1. ; CARC/RARC/Both Codes
  1. ; Prompt for codes to display
  1. ; Active/Inactive
  1. ; Report Date
  1. ; Output report to Excel
  1. ;
  1. EN ; Entry point for Report
  1. N DUOUT,DTOUT,DIR,X,Y,Z,I,JJ,KK,DL,CD,EXLN,IX,RCDT1,RCDET,ZTRTN,ZTSK,ZTDESC,ZTSAVE,ZTSTOP,%ZIS,POP
  1. N RCJOB,RCCD,RCRD,RCNOW,RCODE,RCSTAT,RCPG,RCHR,RCDISP,IDX,TY,FILE,IEN,ZN,RCQUIT,XCNT
  1. S RCQUIT=0
  1. ;
  1. ; Quick Search
  1. G:$G(QS)'=1 R1 ; Go to regular report
  1. ;
  1. D GCD(.RCCD,.RCDET)
  1. I $G(RCCD)="EXIT" G ARCQ
  1. S RCDISP=0,RCSTAT="B",RCDT1=$$DT^XLFDT K ^TMP("RC_CARC_RARC_TABLE",$J)
  1. D GETCODES($G(RCCD("CARC")),$G(RCCD("RARC")),RCSTAT,RCDT1,$NA(^TMP("RC_CARC_RARC_TABLE",$J)))
  1. S RCODE="CARC^RARC",RCNOW=$$NOW^RCDPRU(),RCPG=0,$P(RCHR,"=",IOM)="" ;,IOSL=40
  1. G REPORT
  1. ;
  1. R1 ;
  1. S RCODE=""
  1. S DIR("A")="Select (N)o CARCs or (A)ll CARCs?: ",DIR(0)="SA^N:No CARCs to Include;A:All CARCs Included"
  1. S DIR("B")="ALL" D ^DIR K DIR
  1. I $D(DTOUT)!$D(DUOUT)!(Y="") G ARCQ
  1. S RCDET=$$UP(Y)
  1. I RCDET="A" S RCCD("CARC")="ALL",RCODE="CARC"
  1. ;
  1. S DIR("A")="Select (N)o RARCs or (A)ll RARCs?: ",DIR(0)="SA^N:No RARCs to Include;A:All RARCs Included"
  1. S DIR("B")="ALL" D ^DIR K DIR
  1. I $D(DTOUT)!$D(DUOUT)!(Y="") G ARCQ
  1. S RCDET=$$UP(Y)
  1. I RCDET="A" S RCRD("RARC")="ALL",RCODE=$S(RCODE'="":RCODE_"^RARC",1:"RARC")
  1. ;
  1. I RCODE']"" W !!,"Error: No Codes selected for display...",!,"Please select either CARC and/or RARC to include on report",! G R1
  1. ;
  1. S DIR("A")="Include (A)ctive codes, (I)nactive codes or (B)oth?: ",DIR(0)="SA^A:ACTIVE Codes;I:INACTIVE Codes;B:BOTH ACTIVE/INACTIVE Codes"
  1. S DIR("?")="Active/Inactive will be based on the date selected."
  1. S DIR("?",1)="Please indicate Active/Inactive/Both for codes included on the report."
  1. S DIR("?",2)="Active and Inactive codes will be determined by the date of the report."
  1. S DIR("B")="ACTIVE" D ^DIR K DIR
  1. I $D(DTOUT)!$D(DUOUT)!(Y="") G ARCQ
  1. S RCSTAT=$$UP(Y)
  1. ;
  1. DT1 ; Check the date
  1. S DIR("?")="Enter Date for the report"
  1. S DIR(0)="DAO^:"_DT_":APE",DIR("B")="T",DIR("A")="Report Date: " D ^DIR K DIR
  1. I $D(DTOUT)!$D(DUOUT)!(Y="") G ARCQ
  1. S RCDT1=Y
  1. I RCDT1<2950102 W !,"Invalid date entered, no records for report.",!,"Please select a date after 1/1/1995.",! G DT1
  1. ;
  1. W !
  1. ; Send output to excel. (Removed excel output because description would be truncated)
  1. S RCDISP=0
  1. ;S RCDISP=$$DISPTY^RCDPRU()
  1. ;D:RCDISP INFO^RCDPRU
  1. ;
  1. S %ZIS="QM" D ^%ZIS Q:POP
  1. I $D(IO("Q")) D Q
  1. . S ZTRTN="ENQ^RCDPCRR",ZTDESC="AR - CARC & RARC DATA REPORT",ZTSAVE("*")=""
  1. . D ^%ZTLOAD
  1. . W !!,$S($D(ZTSK):"Your task number"_ZTSK_" has been queued.",1:"Unable to queue this job.")
  1. . K ZTSK,IO("Q") D HOME^%ZIS
  1. U IO
  1. ;
  1. ENQ ; Return here for queued print
  1. S RCNOW=$$NOW^RCDPRU(),RCPG=0,$P(RCHR,"=",IOM)=""
  1. ;
  1. K ^TMP("RC_CARC_RARC_TABLE",$J)
  1. D GETCODES($G(RCCD("CARC")),$G(RCRD("RARC")),RCSTAT,RCDT1,$NA(^TMP("RC_CARC_RARC_TABLE",$J)))
  1. ;
  1. REPORT ;
  1. ; Report
  1. I RCDISP=0 D
  1. . S RCPG=1 W @IOF
  1. . I $G(QS)=1 D HDRP("EDI LOCKBOX CARC/RARC QUICK SEARCH",1,"Page: "_RCPG)
  1. . E D HDRP("EDI LOCKBOX CARC/RARC TABLE DATA REPORT",1,"Page: "_RCPG)
  1. . D HDRP("REPORT RUN DATE: "_RCNOW,1)
  1. . D:+$G(QS)'=1 HDRP($$HDR2(RCSTAT,RCDET,RCDT1),1) W !!
  1. . W $$HDR3(),!
  1. . W RCHR,! S RCSL=8
  1. E W "CODE^START^STOP^MODIFIED^VDATE^TYPE^DESCRIPTION^NOTES",!
  1. S IDX=RCODE
  1. F JJ=1:1 S TY=$P(IDX,U,JJ),CD="" Q:TY=""!RCQUIT S FILE=$S(TY="RARC":346,1:345) F S CD=$O(^TMP("RC_CARC_RARC_TABLE",$J,TY,CD)) Q:CD=""!RCQUIT D
  1. . S IEN="",IEN=$O(^TMP("RC_CARC_RARC_TABLE",$J,TY,CD,IEN)),ZN=$G(^TMP("RC_CARC_RARC_TABLE",$J,TY,CD,IEN))
  1. . K RCDAT,RCERR
  1. . D GETS^DIQ(FILE,IEN_",","4;5","","RCDAT","RCERR") ; Get Description (4) and Notes (5) fields
  1. . I RCDISP D ; Output Excel
  1. .. S EXLN=$P(ZN,U,1)_U_$$DATE($P(ZN,U,2))
  1. .. S EXLN=EXLN_U_$S($P(ZN,U,3)="":"",1:$$DATE($P(ZN,U,3)))_U_$S($P(ZN,U,4)="":"",1:$$DATE($P(ZN,U,4)))_U_$S($P(ZN,U,5)="":"",1:$$DATE($P($P(ZN,U,5),".",1)))_U_TY
  1. .. ; Collect Discription into a single variable for output
  1. .. S KK="",DL=""
  1. .. F S KK=$O(RCDAT(FILE,IEN_",",4,KK)) Q:KK="" S DL=DL_$G(RCDAT(FILE,IEN_",",4,KK))
  1. .. S EXLN=EXLN_U_DL
  1. .. ;Add notes
  1. .. S EXLN=EXLN_U_$G(RCDAT(FILE,IEN_",",5))
  1. .. W EXLN,!
  1. . E D ; Output to the screen
  1. .. W ?(4-$L($P(ZN,U,1))),$P(ZN,U,1),?8,$$DATE($P(ZN,U,2))
  1. .. W:$P(ZN,U,3)'="" ?21,$$DATE($P(ZN,U,3)) W:$P(ZN,U,4)'="" ?35,$$DATE($P(ZN,U,4)) W ?51,TY W:$P(ZN,U,5)'="" ?64,$$DATE($P($P(ZN,U,5),".",1)) W ! S RCSL=RCSL+1
  1. .. I RCSL>=(IOSL-2) S RCQUIT=$$NEWPG(.RCPG,0,.RCSL) G:RCQUIT ARCQ
  1. .. ;Accumulate the Word Processing Description Field
  1. .. S IX="",XCNT=0 K ^UTILITY($J,"W")
  1. .. F S IX=$O(RCDAT(FILE,IEN_",",4,IX)) Q:IX="" S X=RCDAT(FILE,IEN_",",4,IX),DIWL=6,DIWR=IOM,DIWF="W" D ^DIWP S RCSL=RCSL+1 I RCSL>=(IOSL-2) S RCQUIT=$$NEWPG(.RCPG,0,.RCSL) G:RCQUIT ARCQ
  1. .. D ^DIWW S RCSL=RCSL+1
  1. .. I RCSL>=(IOSL-3) S RCQUIT=$$NEWPG(.RCPG,0,.RCSL) G:RCQUIT ARCQ
  1. .. ;Print the Notes Field
  1. .. I $G(RCDAT(FILE,IEN_",",5))'="" K ^UTILITY($J,"W") S X="NOTES: "_RCDAT(FILE,IEN_",",5),DIWL=6,DIWR=IOM,DIWF="" D ^DIWP,^DIWW S RCSL=RCSL+1
  1. .. W ! S RCSL=RCSL+1
  1. .. I RCSL>=(IOSL-3) S RCQUIT=$$NEWPG(.RCPG,0,.RCSL) G:RCQUIT ARCQ
  1. ;
  1. D:'RCQUIT ASK^RCDPRU(.RCSTOP)
  1. ARCQ ; Clean up and quit
  1. K DHDR,RCEXCEL,RCLIST,RCODE,DIWL,DIWR,DIWF,IX,DATA,ERROR,QS
  1. K ^TMP("RC_CARC_RARC_TABLE",$J)
  1. Q
  1. ;
  1. GETCODES(CARC,RARC,STAT,RDT,ARRAY,DESC) ;
  1. ; CARC = CARC data to retrieve
  1. ; RARC = RARC data to retrieve
  1. ; CARC and RARC can be a single code, a list of codes, range or combination.
  1. ; STAT = Retrieve Active, Inactive or Both codes
  1. ; RDT = Report date (used to determine Active/Inactive status)
  1. ; ARRAY = Stuff the data into ARRAY passed for as a string for indirection
  1. ; DESC (optional) = Add description to ARRAY, second ^ is length, if
  1. ; undefined or less than 10 characters description
  1. ; length will be 10 characters, maximum is 250 characters
  1. I $G(DESC)="" S DESC=0
  1. I CARC]"" D ELEM("CARC",345,CARC,STAT,RDT,.ARRAY,DESC)
  1. I RARC]"" D ELEM("RARC",346,RARC,STAT,RDT,.ARRAY,DESC)
  1. Q
  1. ;
  1. ELEM(TYPE,FILE,DAT,STAT,RDT,ARRAY,DESC) ;
  1. N I,OKAY,R1,R2,RX,RY,RZ,O1,ELEM,DATA,START,STOP,DL,RCZT S DL=""
  1. I $G(DESC)'=0 S DL=$P(DESC,U,2) S:+$G(DL)<10 DL=10 S:$G(DL)>250 DL=250
  1. I DAT="ALL" S R1=$O(^RC(FILE,"B","")),R2=$O(^RC(FILE,"B",""),-1),DAT=R1_":"_R2
  1. F I=1:1 S ELEM=$P(DAT,",",I) Q:ELEM="" D
  1. . I ELEM[":" D ; Range
  1. .. S R1=$P(ELEM,":",1),R2=$P(ELEM,":",2),RX=$O(^RC(FILE,"B",R1),-1)
  1. .. F S RX=$O(^RC(FILE,"B",RX)) Q:(RX]]R2)!(RX="") D
  1. ... S O1=$O(^RC(FILE,"B",RX,"")),DATA=^RC(FILE,O1,0),START=$P(DATA,U,2),STOP=$P(DATA,U,3)
  1. ... D:DL'=""
  1. .... ; Get description if wanted
  1. .... K RCZT S RY=$$GET1^DIQ(FILE,O1_",",4,"","RCZT"),RY="",RZ="" F S RZ=$O(RCZT(RZ)) Q:RZ="" S RY=RY_RCZT(RZ)_" "
  1. .... S RY=$E(RY,1,DL)
  1. ... ;S OKAY=$S(STAT="B":1,STAT="I":$S(STOP="":0,STOP<=RDT:1,1:0),STAT="A":$S(STOP="":1,STOP>RDT:1,STOP<=RDT:0,1:0))
  1. ... S OKAY=$$STAT(STAT,RDT,STOP,START)
  1. ... S:OKAY @ARRAY@(TYPE,RX,O1)=DATA S:OKAY&(DL'="") @ARRAY@(TYPE,RX,O1)=@ARRAY@(TYPE,RX,O1)_U_RY
  1. . E D
  1. .. ;Add an individual code
  1. .. S O1=$O(^RC(FILE,"B",ELEM,"")),DATA=^RC(FILE,O1,0),START=$P(DATA,U,2),STOP=$P(DATA,U,3)
  1. .. D:DL'=""
  1. ... ; Get description if wanted
  1. ... K RCZT S RY=$$GET1^DIQ(FILE,O1_",",4,"","RCZT"),RY="",RZ="" F S RZ=$O(RCZT(RZ)) Q:RZ="" S RY=RY_RCZT(RZ)_" "
  1. ... S RY=$E(RY,1,DL)
  1. .. ;S OKAY=$S(STAT="B":1,STAT="I":$S(STOP="":0,STOP<=RDT:1,1:0),STAT="A":$S(STOP="":1,STOP>RDT:1,STOP<=RDT:0,1:0))
  1. .. S OKAY=$$STAT(STAT,RDT,STOP,START)
  1. .. S:OKAY @ARRAY@(TYPE,ELEM,O1)=DATA S:OKAY&(DL'="") @ARRAY@(TYPE,ELEM,O1)=@ARRAY@(TYPE,ELEM,O1)_U_RY
  1. Q
  1. ;
  1. STAT(INC,ZDT,SP,ST) ; Determine if this code should be included in report
  1. ; INC = Active, Inactive, Both; ZDT = Date of report ; ST = Start date of code ; SP = Stop Date of code
  1. N RET S RET=0
  1. I $G(INC)="B" S:($G(ZDT)>$G(ST)) RET=1 Q RET ; Both active and inactive and start date before report date
  1. I $G(INC)="I" S RET=0 D Q RET ; Inactive codes
  1. . I $G(SP)="" S RET=0 Q ; No stop date can't be inactive
  1. . I ($G(ZDT)>$G(SP)),($G(ZDT)>$G(ST)) S RET=1 Q ; Inactive, Stop before report and Start date before report date
  1. I $G(INC)="A" S RET=0 D Q RET
  1. . I $G(ZDT)>$G(ST),($G(SP)="") S RET=1 Q ; Active, Start date before report date and no stop date
  1. . I $G(ZDT)>$G(ST),($G(SP)>$G(ZDT)) S RET=1 Q ; Active, Start date before report date and stop date after report date
  1. Q 0 ; Return do not include
  1. ;
  1. GCARC(RET) ; Get CARC data elements for report
  1. N RCLIST,RCODE,DTOUT,DUOUT,FILE
  1. S FILE=345
  1. S DIR("A")="Select (C)ARC, (R)ange of CARCs or (A)ll ?: ",DIR(0)="SA^A:All CARCs;C:Single CARC;R:Range/List of CARCs"
  1. S DIR("B")="ALL" D ^DIR K DIR
  1. I $D(DTOUT)!$D(DUOUT)!(Y="") S RCSTOP=1 Q
  1. S RCLIST=Y
  1. I RCLIST="A" S RET("CARC")="ALL" Q
  1. I RCLIST="C" D Q
  1. .; if invalid code return here
  1. C1 .;
  1. . S DIR("A")="Enter a CARC code",DIR(0)="P^345;EABZ" ;F^1:200"
  1. . S DIR("?")="Only a single codes can be entered as: A1"
  1. . S DIR("?",1)="Please enter one CARC code for the report."
  1. . S DIR("?",2)="The single validated code will be included in the report."
  1. . S DIR("??")="^D LIST^RCDPCRR(345)"
  1. . D ^DIR K DIR
  1. . I $D(DTOUT)!$D(DUOUT)!(Y="") S RCSTOP=1 Q
  1. . S RCODE=$$UP(X)
  1. . I (RCODE[":"),(RCODE["-"),(RCODE[",") W !!,"Code: "_RCODE_" not found. Please try again...",! S X="",RCODE="" G C1
  1. . I '$$VAL(FILE,.RCODE) W !!,"Code: "_RCODE_" not found, Please reenter...",! S X="",RCODE="" G C1
  1. . S RET("CARC")=RCODE
  1. ;
  1. I RCLIST="R" D
  1. .; if invalid range/list of codes return here
  1. C2 . ;
  1. . S DIR("A")="Enter a List or Range of CARCs",DIR(0)="F^1:200"
  1. . S DIR("?")="Codes can be entered as: 1,2,4:15,A1-B6"
  1. . S DIR("?",1)="Please enter a list or range of CARC Codes, use a comma between elements"
  1. . S DIR("?",2)="and a colon ':' or '-' to delimit ranges of codes."
  1. . S DIR("??")="^D LIST^RCDPCRR(345)"
  1. . D ^DIR K DIR
  1. . I $D(DTOUT)!$D(DUOUT)!(Y="") S RCSTOP=1 Q
  1. . S RCODE=$$UP(X) I '$$VAL(FILE,.RCODE) W !!,"Code: "_RCODE_" not found. Please try again...",! S X="",RCODE="" G C2
  1. . S RET("CARC")=RCODE
  1. Q
  1. ;
  1. LIST(FILE) ; Used for "??" to list the CARC or RARC code and 60 characters of the description
  1. N I,C,QQ,Y,DTOUT,DUOUT,CNT,DIR,RC1,RCZ S CNT=0,C=IOSL-3,QQ=0
  1. S JJ=0 F I=1:1 S JJ=$O(^RC(FILE,JJ)) Q:(+JJ=0)!(QQ=1) D
  1. . S RCZ=^RC(FILE,JJ,0),RC1=$P($G(^RC(FILE,JJ,1,1,0)),".")
  1. . S CNT=CNT+1 W !,$S($P(RCZ,U,3)&($P(RCZ,U,3)'>DT):"*",1:" ")_$J($P(RCZ,U),4),?7,$E(RC1,1,60)
  1. . I CNT#C=0 S DIR(0)="E" D ^DIR I $D(DTOUT)!$D(DUOUT)!(Y="")!(Y="^") S QQ=1 Q
  1. Q
  1. GRARC(RET) ; Get RARC data elements for report
  1. N RCLIST,RCODE,DTOUT,DUOUT,FILE
  1. S FILE=346
  1. S DIR("A")="Select a (R)ARC, Ra(N)ge of RARCs or (A)ll?: ",DIR(0)="SA^A:All RARCs;R:Single RARC;N:Range/List of RARCs"
  1. S DIR("B")="All" D ^DIR K DIR
  1. I $D(DTOUT)!$D(DUOUT)!(Y="") S RCSTOP=1 Q
  1. S RCLIST=Y
  1. I RCLIST="A" S RET("RARC")="ALL" Q
  1. ;
  1. I RCLIST="R" D Q
  1. . ; if invalid code return here
  1. G1 . ;
  1. . S DIR("A")="Enter a RARC code",DIR(0)="F^1:200"
  1. . S DIR("?")="Only a single codes can be entered as: A1"
  1. . S DIR("?",1)="Please enter one RARC for the report."
  1. . S DIR("?",2)="The single validated code will be included in the report."
  1. . S DIR("??")="^D LIST^RCDPCRR(346)"
  1. . D ^DIR K DIR
  1. . I $D(DTOUT)!$D(DUOUT)!(Y="") S RCSTOP=1 Q
  1. . S RCODE=$$UP(X)
  1. . I (RCODE[":"),(RCODE["-"),(RCODE[",") W !!,"Code: "_RCODE_" not found. Please try again...",! S X="",RCODE="" G G1
  1. . I '$$VAL(FILE,.RCODE) W !!,"Code: "_RCODE_" not found, Please try again...",! S X="",RCODE="" G G1
  1. . S RET("RARC")=RCODE
  1. ;
  1. I RCLIST="N" D
  1. .; if invalid range of codes return here
  1. G2 . ;
  1. . S DIR("A")="Enter a List or Range of RARC codes",DIR(0)="F^1:200"
  1. . S DIR("?")="Codes can be entered as: M1,M16:M20,M40-M45"
  1. . S DIR("?",1)="Please enter a list or range of RARC Codes, use a comma ',' between elements"
  1. . S DIR("?",2)="and a colon ':' or '-' to delimit ranges of codes."
  1. . S DIR("??")="^D LIST^RCDPCRR(346)"
  1. . D ^DIR K DIR
  1. . I $D(DTOUT)!$D(DUOUT)!(Y="") S RCSTOP=1 Q
  1. . S RCODE=$$UP(X)
  1. . I '$$VAL(FILE,.RCODE) W !!,"Code: "_RCODE_" not found, Please try again...",! S X="",RCODE="" G G2
  1. . S RET("RARC")=RCODE
  1. Q
  1. ;
  1. GCD(RET,CS) ; Get CARC and/or RARC data elements for Quick Search report
  1. N RCLIST,RCODE,DTOUT,DUOUT,FILE,CK0,CK1,CD,EX
  1. S FILE(0)=345,FILE(1)=346
  1. GC1 ;if invalid code return here
  1. S DIR("A")="Enter a CARC or RARC Code",DIR(0)="F^1:200"
  1. S DIR("?")="Enter codes as a single code or list of codes as: 1 or 1,M1"
  1. S DIR("?",1)="Please enter CARCs and/or RARCs for the report."
  1. S DIR("?",2)="The validated code(s) will be included in the report."
  1. D ^DIR K DIR
  1. I $D(DTOUT)!$D(DUOUT)!(Y="") S RET="EXIT",RCSTOP=1 Q
  1. S RCLIST=$$UP(X)
  1. I (RCLIST[":")!(RCLIST["-") W !!,"Code: "_RCLIST_" not found. Please try again...",! S X="",RCLIST="" G GC1
  1. ; Check each code
  1. S EX=0,CD="" K RET("CARC"),RET("RARC")
  1. F I=1:1 S CD=$P(RCLIST,",",I) Q:CD="" D I EX'=0 W !!,"Code: "_CD_" not found. Please try again...",! S X="",RCLIST="" G GC1
  1. . S CK0=$$VAL(FILE(0),.CD)
  1. . S CK1=$$VAL(FILE(1),.CD)
  1. . ; If both the CARC and RARC returns an invalid set the exit code and quit the checks
  1. . I 'CK0,'CK1 S EX=1 Q ; Abort if we don't have a valid code
  1. . ; Set the appropriate array either CARC or RARC.
  1. . S:CK0 RET("CARC")=$S($G(RET("CARC"))]"":$G(RET("CARC"))_","_CD,1:CD)
  1. . S:CK1 RET("RARC")=$S($G(RET("RARC"))]"":$G(RET("RARC"))_","_CD,1:CD)
  1. ; So are we processing just CARC, just RARC or both CARC and RARC
  1. S CS=$S(($G(RET("CARC"))]"")&($G(RET("CARC"))=""):"C",($G(RET("CARC"))="")&($G(RET("CARC"))]""):"R",1:"B")
  1. Q
  1. ;
  1. DATE(X,F) ; date in external format See XLFDT1 for codes
  1. Q $$DATE^RCDPRU(X,$G(F))
  1. ;
  1. HDR2(ST,RT,DT) ; Report header
  1. N LINE,REP
  1. S LINE=$S(ST="A":"ACTIVE",ST="I":"INACTIVE",1:"ACTIVE AND INACTIVE")
  1. S REP=$S(RT="C":"CARC",RT="R":"RARC",1:"CARC/RARC")
  1. S LINE=LINE_" "_REP_" DATA AS OF REPORT DATE: "_$$DATE(DT)
  1. Q LINE
  1. ;
  1. HDR3() ; Fuction to return report column header lines, just used within this routine.
  1. N LINE
  1. S LINE="CODE START DATE STOP DATE DATE MODIFIED CARC/RARC LAST VISTA UPDATE"_$C(10,13)
  1. S LINE=LINE_" CODE DESCRIPTION"
  1. Q LINE
  1. ;
  1. HDRP(Z,X,Z1) ; Print Header (Z=String, X=1 (line feed) X=0 (no LF), Z1 (page number right justified)
  1. I X=1 W !
  1. W ?(IOM-$L(Z)\2),Z W:$G(Z1)]"" ?(IOM-$L(Z1)),Z1
  1. Q
  1. NEWPG(RCPG,RCNEW,RCSL) ; Check for new page needed, output header
  1. ; RCPG = Page number passwd by referece
  1. ; RCNEW = 1 to force new page
  1. ; RCSL = page length passed by reference
  1. ; Function returns 1 if user chooses to stop output
  1. N RCSTOP S RCSTOP=0
  1. I RCNEW!'RCPG!(($Y+5)>IOSL) D
  1. . D:RCPG ASK^RCDPRU(.RCSTOP) I RCSTOP Q
  1. . S RCPG=RCPG+1 W @IOF
  1. . I $G(QS)=1 D HDRP("EDI LOCKBOX CARC/RARC QUICK SEARCH",1,"Page: "_RCPG)
  1. . E D HDRP("EDI LOCKBOX CARC/RARC TABLE DATA REPORT",1,"Page: "_RCPG)
  1. . D HDRP("REPORT RUN DATE: "_RCNOW,1)
  1. . D:+$G(QS)'=1 HDRP($$HDR2(RCSTAT,RCDET,RCDT1),1) W !!
  1. . W $$HDR3(),!
  1. . W RCHR,! S RCSL=7
  1. Q RCSTOP
  1. ;
  1. VAL(XF,CODE) ; Validate a range or list of CARC (345), RARC (346) or PLB (345.1) Codes
  1. ; If invalid code is found VAILD = 0 and CODE will contain the offending codes
  1. Q $$VAL^RCDPRU(XF,.CODE)
  1. ;
  1. UP(TEXT) ; Translate text to upper case
  1. Q $$UP^XLFSTR(TEXT)
  1. ;