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

RCDPEP.m

Go to the documentation of this file. 
RCDPEP ;AITC/CJE - FLAG PAYERS AS PHARMACY/TRICARE ; 19-APR-2017

 ;;4.5;Accounts Receivable;**321,326,332,371,432**;;Build 16

 ;Per VA Directive 6402, this routine should not be modified.

 ;

EN(FILTER,DATEFILT) ; -- main entry point for RCDPE PAYER FLAGS template

 ; Input: FILTER - A=All payers, P=Pharmacy payers, T=Tricare payers, C=CHAMPVA payers

 ; M=Medical (Neither Pharmacy nor Tricare nor CHAMPVA)

 ; DATEFILT - Additional Filter by Date. Has 3 pieces by '^'

 ;            Piece 1 - 1=Filter by date, 0=Don't

 ;            Piece 2 - START - First DATE ADDED to include(FM format)

 ;            Piece 3 - END - Last DATE ADDED to include (FM format)

 ; 

 I '$D(DATEFILT) S DATEFILT=$$GETDATE()

 I DATEFILT=-1 Q  ;

 I '$D(FILTER) S FILTER=$$GETFILT()

 I FILTER=-1 Q  ;

 ;

 D PAYEN^RCDPESP6 ; PRCA*4.5*332

 D EN^VALM("RCDPE PAYER FLAGS")

 D PAYEX^RCDPESP6 ; PRCA*4.5*332

 Q

 ;

GETDATE() ; Ask if the user wants to filter by date. If so prompt for start

          ; and end dates.

 ; Input: None

 ; Output: Return value=date filter parameters delimiter by '^'

 ;         Piece 1 - 1=Filter by date, 0=Don't

 ;         Piece 2 - START - First DATE ADDED to include(FM format)

 ;         Piece 3 - END - Last DATE ADDED to include (FM format)

 ; 

 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,FD1,FD2,FILTER,OLDDATE,OD1,OD2,RETURN,X,XX,Y

 D FULL^VALM1

 S VALMBCK="R"

 S RETURN="0"

 ;

 S XX=$P($P($G(XQORNOD(0)),"^",4),"=",2) ; User selection with action

 S FD1=$P(XX,";",2),FD2=$P(XX,";",3)

 ; See if user selection is valid (must be T + or - N days)

 S FD1=$$PARSED(FD1)

 S FD2=$$PARSED(FD2)

 I FD1,FD2 Q 1_"^"_FD1_"^"_FD2

 ;

 S OLDDATE=$G(DATEFILT,0)

 S OD1=$P(OLDDATE,"^",2),OD2=$P(OLDDATE,"^",3)

 ;

 S DIR(0)="YA"

 S DIR("A")="Filter by Date Added? "

 S DIR("B")=$S(OLDDATE:"YES",1:"NO")

 S DIR("?",1)="Enter 'Y' or 'Yes' to filter the list by DATE ADDED"

 S DIR("?")="Enter 'N' or 'No' if you do not wish to filter the list by date"

 D ^DIR

 I $D(DIRUT) Q -1

 I Y=0 Q 0

 S RETURN=1

 ;

 ; Prompt for start and end date

 K DIR

 S DIR(0)="DA^"

 S DIR("A")="Filter start date: "

 ; set default to existing filter start date if it is set.

 I OD1'="" S DIR("B")=$$FMTE^XLFDT(OD1,"2DZ")

 D ^DIR

 I $D(DIRUT) Q -1

 S (FD1,$P(RETURN,"^",2))=Y

 ;

 K DIR

 S DIR(0)="DA^"_FD1_":"_DT

 S DIR("A")="Filter end date ("

 S DIR("A")=DIR("A")_$$FMTE^XLFDT(FD1,"2DZ")_"-"

 S DIR("A")=DIR("A")_$$FMTE^XLFDT(DT,"2DZ")_"): "

 ; Set default to existing filter end date if it is valid.

 ; (it must follow the selected start date). Otherwise default to today.

 I OD2'="",OD2'<FD1 S DIR("B")=$$FMTE^XLFDT(OD2,"2DZ")

 I '$D(DIR("B")) S DIR("B")="T"

 D ^DIR

 I $D(DIRUT) Q -1

 S (FD2,$P(RETURN,"^",3))=Y

 ;

 Q RETURN

 ;

GETFILT() ; Get filter on payer type

 ; Input: None

 ; Return: Filter type.

 ;         A=All payers, P=Pharmacy payers, T=Tricare payers, C=CHAMPVA payers

 ;         M=Medical (Neither Pharmacy nor Tricare nor CHAMPVA)

 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,FILTER,X,XX,Y

 ; Check for value specified on protocol

 S XX=$P($P($G(XQORNOD(0)),"^",4),"=",2) ; User selection with action

 S XX=$E(XX)

 I XX'="","APTCM"[XX Q XX

 ;

 S DIR(0)="SA^A:All;P:Pharmacy only;T:Tricare only;C:CHAMPVA only;M:Medical"

 S DIR("A")="Select payers to show. (A)ll, (P)harmacy, (T)ricare, (C)HAMPVA, (M)edical: "

 S DIR("B")="A"

 S DIR("?",1)="Select the type of filter to determine what payers will"

 S DIR("?",2)="be displayed as follows:"

 S DIR("?",3)=" A - All payers including those with and without a flag"

 S DIR("?",4)=" P - Only payers flagged for Pharmacy"

 S DIR("?",5)=" T - Only payers flagged for Tricare"

 S DIR("?",6)=" C - Only payers flagged for CHAMPVA"

 S DIR("?")=" M - Payers NOT flagged for Pharmacy or Tricare or CHAMPVA"

 ; S DIR("??")="RCDPE PAYER FLAGS FILTER"

 ;

 D ^DIR

 I $D(DIRUT) Q -1

 Q Y

 ;

HDR ; EP - header code for RCDPE PAYER FLAGS template

 ; Input: Variables FILTER and DATEFILT are assumed to exist

 ; Output: ListMan template header in VALMHDR array

 ;

 ; Show active filters in the template header

 N FTEXT

 S FTEXT=$S(FILTER="P":"Pharmacy",FILTER="T":"Tricare",FILTER="M":"Medical",FILTER="C":"CHAMPVA",1:"All") ;Add CHAMPVA PRCA*4.5*432

 S FTEXT=$$UP^XLFSTR(FTEXT)

 S FTEXT=FTEXT_" Payers"

 I DATEFILT D  ;

 . S FTEXT=FTEXT_" added between "

 . S FTEXT=FTEXT_$$FMTE^XLFDT($P(DATEFILT,"^",2),"2DZ")

 . S FTEXT=FTEXT_" and "_$$FMTE^XLFDT($P(DATEFILT,"^",3),"2DZ")

 S VALMHDR(1)="Current Filter: "_FTEXT

 Q

 ;

INIT ; EP - init variables and list array for RCDPE PAYER FLAGS template

 ; Input: Variables FILTER and DATEFILT are assumed to exist

 ; Output: ^TMP("RCDPEP",$J) - Body lines to display for selected template

 ;                             ^TMP($J,"RCDPEPIX") - Index of displayed payers

 S SORT="B"

 I $G(FILTER)="" S FILTER="A"

 I $G(DATEFILT)="" S DATEFILT=0

 K ^TMP("RCDPEP",$J),^TMP($J,"RCDPEPIX")

 D BLD(SORT,FILTER,DATEFILT)

 Q  ;

 ;

BLD(SORT,FILTER,DATEFILT) ; - Build the listman body template

 ; Input: SORT=Index on 344.6 to use for display order

 ; FILTER=Filter based on FLAG (see EN subroutine for detail)

 ; DATEFILT=Filter based on date added.

 N CNT,LINE,LN,XX

 D GETPAY(FILTER,DATEFILT) ; get the list of payers sorted and filtered.

 S VALMBG=1,VALMCNT=0,LINE="",CNT=""

 ;

 F  D  Q:CNT=""  ;

 . S CNT=$O(^TMP($J,"RCDPEPIX",CNT))

 . Q:CNT=""  ;

 . S VALMCNT=VALMCNT+1

 . D BLD1PAY(CNT)

 Q

 ;

BLD1PAY(PAYCNT) ; (Re)build one payor line into the listman array

 ; Input PAYCNT - The sequence number of the payer being built

 ; Output - Lines set into template array (^TMP("RCDPEP",$J)).

 N DATALN,LINE,XX

 S LINE=$$SETSTR^VALM1(" "_PAYCNT,"",1,6)    ; PRCA*4.5*371 - Add space for 2 extra characters to line number

 S DATALN=^TMP($J,"RCDPEPIX",PAYCNT)

 S XX=$P(DATALN,"^",2) ; Name

 ;PRCA*4.5*432 Decrease payer by 3 characters to make room for CHAMPVA column, Add CHAMPVA column after Tricare, Adjust column spacing

 S XX=$E(XX,1,52) ; Truncate name to 55 characters to fit ; PRCA*4.5*432 55->52

 S LINE=$$SETSTR^VALM1(XX,LINE,8,52)         ; PRCA*4.5*371 - Add space for 2 extra characters to line number; PRCA*4.5*432 55->52

 S XX=$P(DATALN,"^",3) ; Payer ID

 S LINE=$$SETSTR^VALM1(XX,LINE,62,10)        ; PRCA*4.5*371 - Move to add space for 2 extra characters to line number; PRCA*4.5*432 65->62

 S XX=$P(DATALN,"^",5) ; Phamacy payer flag

 S LINE=$$SETSTR^VALM1(XX,LINE,73,2)         ; PRCA*4.5*371 - Move to add space for 2 extra characters to line number; PRCA*4.5*432 76->73

 S XX=$P(DATALN,"^",6) ; Tricare payer flag

 S LINE=$$SETSTR^VALM1(XX,LINE,76,2)         ; PRCA*4.5*432 79->76

 S XX=$P(DATALN,"^",8) ; CHAMPVA payer flag  ; PRCA*4.5*432 - Add CHAMPVA payer flag

 S LINE=$$SETSTR^VALM1(XX,LINE,79,2)

 S XX=$P(DATALN,"^",4) ; Date added

 S LINE=$$SETSTR^VALM1(XX,LINE,82,10)

 D SET^VALM10(PAYCNT,LINE,PAYCNT)

 S XX=$P(DATALN,"^",7) ; EFT only payer

 S LINE=$$SETSTR^VALM1(XX,LINE,93,3)

 D SET^VALM10(PAYCNT,LINE,PAYCNT)

 Q

 ;

GETPAY(FILTER,DATEFILT) ; Retrieve the payors sorted and filtered

 ; Input: FILTER=Type of filter by Pharmacy or Tricare flag

 ; DATEFILT=Filter by date added

 ; Output: ^TMP($J,"RCDPEPIX")=PIEN^NAME^PHARMACY_FLAG^TRICARE_FLAG

 N CNT,NAME,PIEN

 S CNT=0,NAME=""

 I $G(SORT)="" S SORT="B"

 S FILTER=$G(FILTER)

 F  D  Q:NAME=""  ;

 . S NAME=$O(^RCY(344.6,SORT,NAME))

 . Q:NAME=""

 . S PIEN=""

 . F  S PIEN=$O(^RCY(344.6,SORT,NAME,PIEN)) Q:PIEN=""  D  ; PRCA*4.5*326

 . . I '$$CHKPAY(PIEN,FILTER,DATEFILT) Q  ;

 . . S CNT=CNT+1 D GET1PAY(PIEN,CNT)

 Q  ;

 ;

GET1PAY(PIEN,CNT) ; Get the data for one payer and add it to the list

 ; Input: PIEN - Internal entry number to file 344.6

 ; CNT - Incremental counter

 ; Output: ^TMP($J,"RCDPEPIX",CNT)=A1^A2^A3^A4^A5^A6^A7^A8

 ; Where A1=PIEN - The payer internal entry number on file 344.6

 ;       A2=NAME - The payer name

 ;       A3=PAYER ID (also known as TIN)

 ;       A4=DATE ADDED

 ;       A5=PHARMACY PAYER - A Yes/No/Null field to flag a payer as pharmacy

 ;       A6=TRICARE PAYER - A Yes/No/Null filed to flag a payer as tricare

 ;       A7=EFT PAYER - A Yes/No/Null filed to flag a payer as EFT only

 ;       A8=CHAMPVA PAYER - A Yes/No/Null filed to flag a payer as CHAMPVA   ;PRCA*4.5*432

 ;

 N DATAOUT,DATEA,OUTARR,RCCF,RCID,RCNAME,RCPF,RCTF  ;Add RCCF PRCA*4.5*432

 D GETS^DIQ(344.6,PIEN_",",".01;.02;.03;.09;.1;.15","EI","OUTARR")  ;Add .15 PRCA*4.5*432

 S RCNAME=OUTARR(344.6,PIEN_",",.01,"E")

 S RCID=OUTARR(344.6,PIEN_",",.02,"E")

 S DATAOUT=PIEN

 S DATAOUT=DATAOUT_"^"_RCNAME ; Name

 S DATAOUT=DATAOUT_"^"_RCID ; Payer ID

 S DATEA=OUTARR(344.6,PIEN_",",.03,"I") ; Date added

 S DATEA=$$FMTE^XLFDT(DATEA,"2DZ") ; Format as MM/DD/YY

 S DATAOUT=DATAOUT_"^"_DATEA

 S RCPF=$S(OUTARR(344.6,PIEN_",",.09,"I"):"Y",1:"")

 S DATAOUT=DATAOUT_"^"_RCPF ; Pharmacy payer flag

 S RCTF=$S(OUTARR(344.6,PIEN_",",.1,"I"):"Y",1:"")

 S DATAOUT=DATAOUT_"^"_RCTF ; Tricare payer flag

 S DATAOUT=DATAOUT_"^"_$S('$D(^RCY(344.4,"APT",RCNAME,RCID)):"YES",1:"") ; EFT ONLY PAYER/TIN

 S RCCF=$S(OUTARR(344.6,PIEN_",",.15,"I"):"Y",1:"") ; CHAMPVA payer flag PRCA*4.5*432

 S DATAOUT=DATAOUT_"^"_RCCF ; CHAMPVA payer flag PRCA*4.5*432

 S ^TMP($J,"RCDPEPIX",CNT)=DATAOUT

 Q

 ;

CHKPAY(PIEN,FILTER,DATEFILT) ; Apply selected filters to a payer

 ; Input: PIEN - Internal entry number to file 344.6

 ; FILTER - A=All payers, P=Pharmacy payers, T=Tricare payers, C=CHAMPVA payers

 ;          M=Medical (Neither Pharmacy nor Tricare nor CHAMPVA)

 ; DATEFILT - Additional Filter by Date. Has 3 pieces by '^'

 ;            Piece 1 - 1=Filter by date, 0=Don't

 ;            Piece 2 - START - First DATE ADDED to include(FM format)

 ;            Piece 3 - END - Last DATE ADDED to include (FM format)

 ; Returns: 1 if record matches filter, otherwise 0.

 N D1,D2,DC,CFLAG,CREATED,MATCHT,MATCHD,PFLAG,TFLAG  ;Add CFLAG PRCA*4.5*432

 S (MATCHT,MATCHD)=0

 I FILTER="A" D  ;

 . S MATCHT=1

 E  D  ;

 . S PFLAG=$$GET1^DIQ(344.6,PIEN_",",.09,"I")

 . S TFLAG=$$GET1^DIQ(344.6,PIEN_",",.1,"I")

 . S CFLAG=$$GET1^DIQ(344.6,PIEN_",",.15,"I") ;Add CFLAG, CHAMPVA payer flag PRCA*4.5*432

 . I FILTER="P",PFLAG S MATCHT=1

 . I FILTER="T",TFLAG S MATCHT=1

 . I FILTER="C",CFLAG S MATCHT=1  ;CHAMPVA payer flag PRCA*4.5*432

 . I FILTER="M",'PFLAG,'TFLAG,'CFLAG S MATCHT=1  ;Add reference to 'CFLAG PRCA*4.5*432

 ;

 I 'DATEFILT D  ;

 . S MATCHD=1

 E  D  ;

 . S D1=$P(DATEFILT,"^",2)

 . S D2=$P(DATEFILT,"^",3)

 . S DC=$$GET1^DIQ(344.6,PIEN_",",.03,"I")

 . S DC=$P(DC,".",1) ; strip off the time portion for comparison

 . I DC=D1!(DC=D2)!(DC>D1&(DC<D2)) S MATCHD=1

 ; 

 Q MATCHT&MATCHD

 ;

CHKKEY() ; Check security key for editing

 ; Inputs: None

 ; Returns: 1 - User has security key editing, 0 - User does not have key

 ;

 Q 1 ; Always return 1 since security key is no longer required.

 N RET

 D OWNSKEY^XUSRB(.RET,"RCDPE PAYER IDENTIFY")

 I 'RET(0) D  ;

 . W !!,*7,">>>> Security key RCDPE PAYER IDENTIFY is required for this action"

 . D PAUSE^VALM1

 Q RET(0)

 ;

EDIT ; EP - for RCDPE PAYER FLAGS EDIT protocol

 ; Input: None

 ; Output: File 344.6 is updated

 ;         Listman array is updated

 ;

 N DA,DIC,DIE,DO,DR,DTOUT,EDT,LINE,PCNT,PIEN,PROMPT,RET,SEL,X,XX,Y

 S VALMBCK="R"

 D FULL^VALM1

 ; Check security key for edit access

 I '$$CHKKEY() Q  ;

 ;

 S PROMPT="Select a Payer Entry to edit: "

 S PIEN=$$SELENT(1,PROMPT,VALMBG,VALMLST,.SEL,"RCDPEPIX",0)

 Q:'PIEN

 ;

 ; Lock Editing of this payer entry

 L +^RCY(344.6,PIEN):3 I '$T D  Q

  . W !!,*7,"Someone else is editing this Payer Entry."

  . W !,"Try again later."

  . D PAUSE^VALM1

 ;

 ; Let the user edit the payer entry

 S DIE="^RCY(344.6,"

 W !!,"Edit flags for payer : "_$$GET1^DIQ(344.6,PIEN_",",.01,"E"),!

 S DA=PIEN

 S DR=".09Pharmacy Flag;.1Tricare Flag;.15CHAMPVA Flag"  ;Add CHAMPVA PRCA*4.5*4.32

 D ^DIE

 ;

 L -^RCY(344.6,PIEN)

 D GET1PAY(PIEN,+SEL)

 D BLD1PAY(+SEL)

 Q

 ;

SELENT(FULL,PROMPT,START,END,PCNT,WLIST,MULT) ; EP - Protocol Action

 ; Select Entry(s) to perform an action upon

 ; Called from protocols : RCDPE PAYER FLAGS EDIT

 ; RCDPE PAYER FLAG PHARM

 ; RCDPE PAYER FLAG TRIC

 ; Input: FULL - 1 - full screen mode, 0 otherwise

 ;        PROMPT - Prompt to be displayed to the user

 ;        START - Starting selection value

 ;        END - Ending selection value

 ;        WLIST - Worklist, the user is selecting from

 ;                Optional, defaults to 'RCDPEPIX'

 ;        MULT - 1 to allow multiple selection,

 ;               0 or null otherwise

 ;               Optional defaults to 0

 ; Output: PCNT - Selected Phone Book Entry line(s)

 ; Returns: Selected Payer Entry IEN(s)

 ;          Error message if invalid selection

 N CTR,DIROUT,DIRUT,DLINE,DTOUT,DUOUT,PIEN,PIENS,X,XX,Y,YY

 S:'$D(WLIST) WLIST="RCDPEPIX"

 S:'$D(MULT) MULT=0

 D:FULL FULL^VALM1

 ; Check for multi-selection

 S PCNT=$$PARSEL($G(XQORNOD(0)),START,END)

 ;

 ; W !!!,"PCNT="_PCNT_" MULT="_MULT H 10

 I 'MULT,$P(PCNT,",",2) D  Q ""                      ; Invalid multi-selection

 . W !,*7,">>>> Only single entry selection is allowed"

 . K DIR

 . D PAUSE^VALM1

 S:PCNT="" PCNT=$$SELENTRY(PROMPT,START,END,MULT)

 Q:'PCNT ""

 ;

 S PIENS=""

 F CTR=1:1:$L(PCNT,",") D

 . S XX=$P(PCNT,",",CTR)

 . I XX'="" D  ;

 . . S YY=$P(^TMP($J,WLIST,XX),"^",1)

 . . S PIENS=$S(PIENS="":YY,1:PIENS_","_YY)

 Q PIENS

 ;

SELENTRY(PROMPT,START,END,MULT) ; Select a line 

 ; Input: PROMPT - Prompt to be displayed to the user

 ; START - Start comment # that can be selected

 ; END - Ending comment # that can be selected

 ; MULT - 1=Multiple selection allowed, 0=otherwise

 ; Returns: Selected Comment # or "" if not selected

 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y

 S MULT=+$G(MULT)

 S DIR(0)=$S(MULT:"L",1:"N")_"O^"_START_":"_END_":0"

 S DIR("A")=PROMPT

 D ^DIR K DIR

 Q Y

 ;

FLAGP ; EP - for RCDPE PAYER FLAG PHARM protocol

 ; Toggle pharmacy flag on selected lines

 ; Input: None

 ; Output: None 

 D FLAG("P")

 Q

 ;

FLAGT ; EP - for RCDPE PAYER FLAG TRIC protocol

 ; Toggle Tricare flag on selected lines

 ; Input: None

 ; Output: None 

 D FLAG("T")

 Q

 ;

FLAGC ; EP - for RCDPE PAYER FLAG CVA protocol ; Add CHAMPVA flag PRCA*4.5*432

 ; Toggle CHAMPVA flag on selected lines

 ; Input: None

 ; Output: None 

 D FLAG("C")

 Q

 ;

FLAG(TYPE) ; Flag a list of entries as Pharmacy or Tricare or CHAMPVA

 ; Input: TYPE - P=Pharmacy, T=Tricare, C=CHAMPVA

 ; Output: File 344.6 is updated

 ; ListMan array is updated

 N CONTINUE,CTR,FIELD,PERR,PIEN,PIENS,PROMPT,SELS,STOP,XX,ZS,ZZ

 S FIELD=$S(TYPE="P":.09,TYPE="T":.1,1:.15)  ;Add CHAMPVA PRCA*4.5*432

 S VALMBCK="R"

 ; Check security key for edit access

 I '$$CHKKEY() Q  ;

 ;

 S PROMPT="Select lines on which to toggle "

 S PROMPT=PROMPT_$S(TYPE="P":"Pharmacy",TYPE="T":"Tricare",1:"CHAMPVA")_" Flag"  ;Add CHAMPVA PRCA*4.5*432

 S PIENS=$$SELENT(1,PROMPT,VALMBG,VALMLST,.SELS,"RCDPEPIX",1)

 Q:PIENS=""  ;

 S (PERR,PIEN,ZZ,ZS)=""

 ;

 ; First lock all entries to be deleted

 F CTR=1:1:$L(PIENS,",") D

 . S PIEN=$P(PIENS,",",CTR) I PIEN="" Q  ;

 . S XX=$P(SELS,",",CTR)

 . ;

 . ; Lock this payer exclusion for editing 

 . L +^RCY(344.6,PIEN):3 I '$T D  Q

 . . S PERR=$S(PERR="":XX,1:PERR_","_XX)

 . S ZZ=$S(ZZ="":PIEN,1:ZZ_","_PIEN)

 . S ZS=$S(ZS="":XX,1:ZS_","_XX)

 S PIENS=ZZ                                ; Entry(s) that can be deleted

 S SELS=ZS

 ;

 ; Did we lock at least one entry?

 I PIENS="" D  Q

 . W !!,*7,"All entries are being edited by another user - Nothing done."

 . D PAUSE^VALM1

 ;

 ; Next warn the user if we couldn't lock them all

 I PERR'="" D  Q:STOP

 . S STOP=0

 . W !!,*7,"Warning: The following entries: ",PERR," are being edited by another user"

 . W !,"These entries will not be updated."

 . S CONTINUE=$$ASKYN("Continue with update of other payers?")

 . I 'CONTINUE D

 . . S STOP=1

 . . F CTR=1:1:$L(PIENS,",") D

 . . . S PIEN=$P(PIENS,",",CTR)

 . . . L -^RCY(344.6,PIEN)

 ;

 ; Flag selected entries

 F CTR=1:1:$L(PIENS,",") D  ;

 . N FDA,IENS,OLDVAL,VALUE

 . S PIEN=$P(PIENS,",",CTR)

 . S IENS=PIEN_","

 . S SEL=$P(SELS,",",CTR)

 . S OLDVAL=$$GET1^DIQ(344.6,IENS,FIELD,"I")

 . S VALUE=$S('OLDVAL:1,1:0)

 . S FDA(344.6,IENS,FIELD)=VALUE

 . L -^RCY(344.6,PIEN)

 . D FILE^DIE("","FDA")

 . D GET1PAY(PIEN,SEL)

 . D BLD1PAY(SEL)

 Q

 ;

FILTER ; EP - for RCDPE PAYER FLAGS FILTER protocol

 ; Change the filter from a protocol

 ; Inputs - None

 ; Output - Sets variables FILTER and DATEFILT

 N NEWDATE,NEWFILT

 S VALMBCK="R"

 D FULL^VALM1

 S NEWDATE=$$GETDATE()

 I NEWDATE=-1 Q  ;

 S NEWFILT=$$GETFILT()

 I NEWFILT=-1 Q  ;

 S DATEFILT=NEWDATE

 S FILTER=NEWFILT

 D HDR,INIT

 Q

 ;

PARSEL(VALMNOD,BEG,END) ; -- split out pre-answers from user

 ; Inputs - VALMNOD= User input from protocol menu including pre-answers

 ;          BEG=Begining of the valid numeric range

 ;          END=End of the valid numeric range

 ; Returns - Y=Comma separated list of valid numeric entries

 ;

 ; This code is adapted from VALM2. 

 N I,J,L,X,Y

 S Y=$TR($P($P(VALMNOD,U,4),"=",2),"/\; .",",,,,,")

 ; Run through the list, skip invalid selections and expand ranges

 S X=Y,Y=""

 F I=1:1 S J=$P(X,",",I) Q:J=""  D  ;

 . I J'["-",J>(BEG-1),J<(END+1) S Y=Y_J_"," ; single valid selection 

 . I J["-",J,J<$P(J,"-",2) D  ;

 . . F L=+J:1:+$P(J,"-",2) D  ;

 . . . I L>(BEG-1),L<(END+1) S Y=Y_L_"," ; valid selection from expanded range

 Q Y

 ;

PARSED(X) ; Take a date in external format and check if it is a valid

          ; DATE ADDED (.03) in file 344.6

 ; Input - Date in External format

 ; Output - Date in Fileman format or 0 if the input was invalid

 D VAL^DIE(344.6,"+1,",.03,"",X,.RET)

 Q RET

 ;

ASKYN(PROMPT,DEFAULT) ; Ask a yes/no question

 ; Input: PROMPT - Question to be asked

 ;        DEFAULT - Default Answer

 ;        1 - YES, 0 - NO

 ;        Optional, defaults to 0

 ; Returns: 1 - User answered YES, 0 othewise

 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y

 S:$G(DEFAULT)'=1 DEFAULT=0

 S DIR(0)="Y",DIR("A")=PROMPT

 S DIR("B")=$S(DEFAULT:"YES",1:"NO")

 D ^DIR

 Q Y

 ;

HELP ; EP - for template RCDPE PAYER FLAGS help

 ; Input: None

 ; Output: Text from a help frame displayed to the screen

 N FILTER,DATEFILT,XQH

 S VALMBCK="R"

 S XQH="RCDPE PAYER FLAGS GENERAL"

 D EN^XQH

 Q

 ;

EXIT ; -- exit code

 D FULL^VALM1

 Q