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.
  1. RCDPEP ;AITC/CJE - FLAG PAYERS AS PHARMACY/TRICARE ; 19-APR-2017
  1. ;;4.5;Accounts Receivable;**321,326,332,371,432**;;Build 16
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. EN(FILTER,DATEFILT) ; -- main entry point for RCDPE PAYER FLAGS template
  1. ; Input: FILTER - A=All payers, P=Pharmacy payers, T=Tricare payers, C=CHAMPVA payers
  1. ; M=Medical (Neither Pharmacy nor Tricare nor CHAMPVA)
  1. ; DATEFILT - Additional Filter by Date. Has 3 pieces by '^'
  1. ; Piece 1 - 1=Filter by date, 0=Don't
  1. ; Piece 2 - START - First DATE ADDED to include(FM format)
  1. ; Piece 3 - END - Last DATE ADDED to include (FM format)
  1. ;
  1. I '$D(DATEFILT) S DATEFILT=$$GETDATE()
  1. I DATEFILT=-1 Q ;
  1. I '$D(FILTER) S FILTER=$$GETFILT()
  1. I FILTER=-1 Q ;
  1. ;
  1. D PAYEN^RCDPESP6 ; PRCA*4.5*332
  1. D EN^VALM("RCDPE PAYER FLAGS")
  1. D PAYEX^RCDPESP6 ; PRCA*4.5*332
  1. Q
  1. ;
  1. GETDATE() ; Ask if the user wants to filter by date. If so prompt for start
  1. ; and end dates.
  1. ; Input: None
  1. ; Output: Return value=date filter parameters delimiter by '^'
  1. ; Piece 1 - 1=Filter by date, 0=Don't
  1. ; Piece 2 - START - First DATE ADDED to include(FM format)
  1. ; Piece 3 - END - Last DATE ADDED to include (FM format)
  1. ;
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,FD1,FD2,FILTER,OLDDATE,OD1,OD2,RETURN,X,XX,Y
  1. D FULL^VALM1
  1. S VALMBCK="R"
  1. S RETURN="0"
  1. ;
  1. S XX=$P($P($G(XQORNOD(0)),"^",4),"=",2) ; User selection with action
  1. S FD1=$P(XX,";",2),FD2=$P(XX,";",3)
  1. ; See if user selection is valid (must be T + or - N days)
  1. S FD1=$$PARSED(FD1)
  1. S FD2=$$PARSED(FD2)
  1. I FD1,FD2 Q 1_"^"_FD1_"^"_FD2
  1. ;
  1. S OLDDATE=$G(DATEFILT,0)
  1. S OD1=$P(OLDDATE,"^",2),OD2=$P(OLDDATE,"^",3)
  1. ;
  1. S DIR(0)="YA"
  1. S DIR("A")="Filter by Date Added? "
  1. S DIR("B")=$S(OLDDATE:"YES",1:"NO")
  1. S DIR("?",1)="Enter 'Y' or 'Yes' to filter the list by DATE ADDED"
  1. S DIR("?")="Enter 'N' or 'No' if you do not wish to filter the list by date"
  1. D ^DIR
  1. I $D(DIRUT) Q -1
  1. I Y=0 Q 0
  1. S RETURN=1
  1. ;
  1. ; Prompt for start and end date
  1. K DIR
  1. S DIR(0)="DA^"
  1. S DIR("A")="Filter start date: "
  1. ; set default to existing filter start date if it is set.
  1. I OD1'="" S DIR("B")=$$FMTE^XLFDT(OD1,"2DZ")
  1. D ^DIR
  1. I $D(DIRUT) Q -1
  1. S (FD1,$P(RETURN,"^",2))=Y
  1. ;
  1. K DIR
  1. S DIR(0)="DA^"_FD1_":"_DT
  1. S DIR("A")="Filter end date ("
  1. S DIR("A")=DIR("A")_$$FMTE^XLFDT(FD1,"2DZ")_"-"
  1. S DIR("A")=DIR("A")_$$FMTE^XLFDT(DT,"2DZ")_"): "
  1. ; Set default to existing filter end date if it is valid.
  1. ; (it must follow the selected start date). Otherwise default to today.
  1. I OD2'="",OD2'<FD1 S DIR("B")=$$FMTE^XLFDT(OD2,"2DZ")
  1. I '$D(DIR("B")) S DIR("B")="T"
  1. D ^DIR
  1. I $D(DIRUT) Q -1
  1. S (FD2,$P(RETURN,"^",3))=Y
  1. ;
  1. Q RETURN
  1. ;
  1. GETFILT() ; Get filter on payer type
  1. ; Input: None
  1. ; Return: Filter type.
  1. ; A=All payers, P=Pharmacy payers, T=Tricare payers, C=CHAMPVA payers
  1. ; M=Medical (Neither Pharmacy nor Tricare nor CHAMPVA)
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,FILTER,X,XX,Y
  1. ; Check for value specified on protocol
  1. S XX=$P($P($G(XQORNOD(0)),"^",4),"=",2) ; User selection with action
  1. S XX=$E(XX)
  1. I XX'="","APTCM"[XX Q XX
  1. ;
  1. S DIR(0)="SA^A:All;P:Pharmacy only;T:Tricare only;C:CHAMPVA only;M:Medical"
  1. S DIR("A")="Select payers to show. (A)ll, (P)harmacy, (T)ricare, (C)HAMPVA, (M)edical: "
  1. S DIR("B")="A"
  1. S DIR("?",1)="Select the type of filter to determine what payers will"
  1. S DIR("?",2)="be displayed as follows:"
  1. S DIR("?",3)=" A - All payers including those with and without a flag"
  1. S DIR("?",4)=" P - Only payers flagged for Pharmacy"
  1. S DIR("?",5)=" T - Only payers flagged for Tricare"
  1. S DIR("?",6)=" C - Only payers flagged for CHAMPVA"
  1. S DIR("?")=" M - Payers NOT flagged for Pharmacy or Tricare or CHAMPVA"
  1. ; S DIR("??")="RCDPE PAYER FLAGS FILTER"
  1. ;
  1. D ^DIR
  1. I $D(DIRUT) Q -1
  1. Q Y
  1. ;
  1. HDR ; EP - header code for RCDPE PAYER FLAGS template
  1. ; Input: Variables FILTER and DATEFILT are assumed to exist
  1. ; Output: ListMan template header in VALMHDR array
  1. ;
  1. ; Show active filters in the template header
  1. N FTEXT
  1. S FTEXT=$S(FILTER="P":"Pharmacy",FILTER="T":"Tricare",FILTER="M":"Medical",FILTER="C":"CHAMPVA",1:"All") ;Add CHAMPVA PRCA*4.5*432
  1. S FTEXT=$$UP^XLFSTR(FTEXT)
  1. S FTEXT=FTEXT_" Payers"
  1. I DATEFILT D ;
  1. . S FTEXT=FTEXT_" added between "
  1. . S FTEXT=FTEXT_$$FMTE^XLFDT($P(DATEFILT,"^",2),"2DZ")
  1. . S FTEXT=FTEXT_" and "_$$FMTE^XLFDT($P(DATEFILT,"^",3),"2DZ")
  1. S VALMHDR(1)="Current Filter: "_FTEXT
  1. Q
  1. ;
  1. INIT ; EP - init variables and list array for RCDPE PAYER FLAGS template
  1. ; Input: Variables FILTER and DATEFILT are assumed to exist
  1. ; Output: ^TMP("RCDPEP",$J) - Body lines to display for selected template
  1. ; ^TMP($J,"RCDPEPIX") - Index of displayed payers
  1. S SORT="B"
  1. I $G(FILTER)="" S FILTER="A"
  1. I $G(DATEFILT)="" S DATEFILT=0
  1. K ^TMP("RCDPEP",$J),^TMP($J,"RCDPEPIX")
  1. D BLD(SORT,FILTER,DATEFILT)
  1. Q ;
  1. ;
  1. BLD(SORT,FILTER,DATEFILT) ; - Build the listman body template
  1. ; Input: SORT=Index on 344.6 to use for display order
  1. ; FILTER=Filter based on FLAG (see EN subroutine for detail)
  1. ; DATEFILT=Filter based on date added.
  1. N CNT,LINE,LN,XX
  1. D GETPAY(FILTER,DATEFILT) ; get the list of payers sorted and filtered.
  1. S VALMBG=1,VALMCNT=0,LINE="",CNT=""
  1. ;
  1. F D Q:CNT="" ;
  1. . S CNT=$O(^TMP($J,"RCDPEPIX",CNT))
  1. . Q:CNT="" ;
  1. . S VALMCNT=VALMCNT+1
  1. . D BLD1PAY(CNT)
  1. Q
  1. ;
  1. BLD1PAY(PAYCNT) ; (Re)build one payor line into the listman array
  1. ; Input PAYCNT - The sequence number of the payer being built
  1. ; Output - Lines set into template array (^TMP("RCDPEP",$J)).
  1. N DATALN,LINE,XX
  1. S LINE=$$SETSTR^VALM1(" "_PAYCNT,"",1,6) ; PRCA*4.5*371 - Add space for 2 extra characters to line number
  1. S DATALN=^TMP($J,"RCDPEPIX",PAYCNT)
  1. S XX=$P(DATALN,"^",2) ; Name
  1. ;PRCA*4.5*432 Decrease payer by 3 characters to make room for CHAMPVA column, Add CHAMPVA column after Tricare, Adjust column spacing
  1. S XX=$E(XX,1,52) ; Truncate name to 55 characters to fit ; PRCA*4.5*432 55->52
  1. 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
  1. S XX=$P(DATALN,"^",3) ; Payer ID
  1. 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
  1. S XX=$P(DATALN,"^",5) ; Phamacy payer flag
  1. 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
  1. S XX=$P(DATALN,"^",6) ; Tricare payer flag
  1. S LINE=$$SETSTR^VALM1(XX,LINE,76,2) ; PRCA*4.5*432 79->76
  1. S XX=$P(DATALN,"^",8) ; CHAMPVA payer flag ; PRCA*4.5*432 - Add CHAMPVA payer flag
  1. S LINE=$$SETSTR^VALM1(XX,LINE,79,2)
  1. S XX=$P(DATALN,"^",4) ; Date added
  1. S LINE=$$SETSTR^VALM1(XX,LINE,82,10)
  1. D SET^VALM10(PAYCNT,LINE,PAYCNT)
  1. S XX=$P(DATALN,"^",7) ; EFT only payer
  1. S LINE=$$SETSTR^VALM1(XX,LINE,93,3)
  1. D SET^VALM10(PAYCNT,LINE,PAYCNT)
  1. Q
  1. ;
  1. GETPAY(FILTER,DATEFILT) ; Retrieve the payors sorted and filtered
  1. ; Input: FILTER=Type of filter by Pharmacy or Tricare flag
  1. ; DATEFILT=Filter by date added
  1. ; Output: ^TMP($J,"RCDPEPIX")=PIEN^NAME^PHARMACY_FLAG^TRICARE_FLAG
  1. N CNT,NAME,PIEN
  1. S CNT=0,NAME=""
  1. I $G(SORT)="" S SORT="B"
  1. S FILTER=$G(FILTER)
  1. F D Q:NAME="" ;
  1. . S NAME=$O(^RCY(344.6,SORT,NAME))
  1. . Q:NAME=""
  1. . S PIEN=""
  1. . F S PIEN=$O(^RCY(344.6,SORT,NAME,PIEN)) Q:PIEN="" D ; PRCA*4.5*326
  1. . . I '$$CHKPAY(PIEN,FILTER,DATEFILT) Q ;
  1. . . S CNT=CNT+1 D GET1PAY(PIEN,CNT)
  1. Q ;
  1. ;
  1. GET1PAY(PIEN,CNT) ; Get the data for one payer and add it to the list
  1. ; Input: PIEN - Internal entry number to file 344.6
  1. ; CNT - Incremental counter
  1. ; Output: ^TMP($J,"RCDPEPIX",CNT)=A1^A2^A3^A4^A5^A6^A7^A8
  1. ; Where A1=PIEN - The payer internal entry number on file 344.6
  1. ; A2=NAME - The payer name
  1. ; A3=PAYER ID (also known as TIN)
  1. ; A4=DATE ADDED
  1. ; A5=PHARMACY PAYER - A Yes/No/Null field to flag a payer as pharmacy
  1. ; A6=TRICARE PAYER - A Yes/No/Null filed to flag a payer as tricare
  1. ; A7=EFT PAYER - A Yes/No/Null filed to flag a payer as EFT only
  1. ; A8=CHAMPVA PAYER - A Yes/No/Null filed to flag a payer as CHAMPVA ;PRCA*4.5*432
  1. ;
  1. N DATAOUT,DATEA,OUTARR,RCCF,RCID,RCNAME,RCPF,RCTF ;Add RCCF PRCA*4.5*432
  1. D GETS^DIQ(344.6,PIEN_",",".01;.02;.03;.09;.1;.15","EI","OUTARR") ;Add .15 PRCA*4.5*432
  1. S RCNAME=OUTARR(344.6,PIEN_",",.01,"E")
  1. S RCID=OUTARR(344.6,PIEN_",",.02,"E")
  1. S DATAOUT=PIEN
  1. S DATAOUT=DATAOUT_"^"_RCNAME ; Name
  1. S DATAOUT=DATAOUT_"^"_RCID ; Payer ID
  1. S DATEA=OUTARR(344.6,PIEN_",",.03,"I") ; Date added
  1. S DATEA=$$FMTE^XLFDT(DATEA,"2DZ") ; Format as MM/DD/YY
  1. S DATAOUT=DATAOUT_"^"_DATEA
  1. S RCPF=$S(OUTARR(344.6,PIEN_",",.09,"I"):"Y",1:"")
  1. S DATAOUT=DATAOUT_"^"_RCPF ; Pharmacy payer flag
  1. S RCTF=$S(OUTARR(344.6,PIEN_",",.1,"I"):"Y",1:"")
  1. S DATAOUT=DATAOUT_"^"_RCTF ; Tricare payer flag
  1. S DATAOUT=DATAOUT_"^"_$S('$D(^RCY(344.4,"APT",RCNAME,RCID)):"YES",1:"") ; EFT ONLY PAYER/TIN
  1. S RCCF=$S(OUTARR(344.6,PIEN_",",.15,"I"):"Y",1:"") ; CHAMPVA payer flag PRCA*4.5*432
  1. S DATAOUT=DATAOUT_"^"_RCCF ; CHAMPVA payer flag PRCA*4.5*432
  1. S ^TMP($J,"RCDPEPIX",CNT)=DATAOUT
  1. Q
  1. ;
  1. CHKPAY(PIEN,FILTER,DATEFILT) ; Apply selected filters to a payer
  1. ; Input: PIEN - Internal entry number to file 344.6
  1. ; FILTER - A=All payers, P=Pharmacy payers, T=Tricare payers, C=CHAMPVA payers
  1. ; M=Medical (Neither Pharmacy nor Tricare nor CHAMPVA)
  1. ; DATEFILT - Additional Filter by Date. Has 3 pieces by '^'
  1. ; Piece 1 - 1=Filter by date, 0=Don't
  1. ; Piece 2 - START - First DATE ADDED to include(FM format)
  1. ; Piece 3 - END - Last DATE ADDED to include (FM format)
  1. ; Returns: 1 if record matches filter, otherwise 0.
  1. N D1,D2,DC,CFLAG,CREATED,MATCHT,MATCHD,PFLAG,TFLAG ;Add CFLAG PRCA*4.5*432
  1. S (MATCHT,MATCHD)=0
  1. I FILTER="A" D ;
  1. . S MATCHT=1
  1. E D ;
  1. . S PFLAG=$$GET1^DIQ(344.6,PIEN_",",.09,"I")
  1. . S TFLAG=$$GET1^DIQ(344.6,PIEN_",",.1,"I")
  1. . S CFLAG=$$GET1^DIQ(344.6,PIEN_",",.15,"I") ;Add CFLAG, CHAMPVA payer flag PRCA*4.5*432
  1. . I FILTER="P",PFLAG S MATCHT=1
  1. . I FILTER="T",TFLAG S MATCHT=1
  1. . I FILTER="C",CFLAG S MATCHT=1 ;CHAMPVA payer flag PRCA*4.5*432
  1. . I FILTER="M",'PFLAG,'TFLAG,'CFLAG S MATCHT=1 ;Add reference to 'CFLAG PRCA*4.5*432
  1. ;
  1. I 'DATEFILT D ;
  1. . S MATCHD=1
  1. E D ;
  1. . S D1=$P(DATEFILT,"^",2)
  1. . S D2=$P(DATEFILT,"^",3)
  1. . S DC=$$GET1^DIQ(344.6,PIEN_",",.03,"I")
  1. . S DC=$P(DC,".",1) ; strip off the time portion for comparison
  1. . I DC=D1!(DC=D2)!(DC>D1&(DC<D2)) S MATCHD=1
  1. ;
  1. Q MATCHT&MATCHD
  1. ;
  1. CHKKEY() ; Check security key for editing
  1. ; Inputs: None
  1. ; Returns: 1 - User has security key editing, 0 - User does not have key
  1. ;
  1. Q 1 ; Always return 1 since security key is no longer required.
  1. N RET
  1. D OWNSKEY^XUSRB(.RET,"RCDPE PAYER IDENTIFY")
  1. I 'RET(0) D ;
  1. . W !!,*7,">>>> Security key RCDPE PAYER IDENTIFY is required for this action"
  1. . D PAUSE^VALM1
  1. Q RET(0)
  1. ;
  1. EDIT ; EP - for RCDPE PAYER FLAGS EDIT protocol
  1. ; Input: None
  1. ; Output: File 344.6 is updated
  1. ; Listman array is updated
  1. ;
  1. N DA,DIC,DIE,DO,DR,DTOUT,EDT,LINE,PCNT,PIEN,PROMPT,RET,SEL,X,XX,Y
  1. S VALMBCK="R"
  1. D FULL^VALM1
  1. ; Check security key for edit access
  1. I '$$CHKKEY() Q ;
  1. ;
  1. S PROMPT="Select a Payer Entry to edit: "
  1. S PIEN=$$SELENT(1,PROMPT,VALMBG,VALMLST,.SEL,"RCDPEPIX",0)
  1. Q:'PIEN
  1. ;
  1. ; Lock Editing of this payer entry
  1. L +^RCY(344.6,PIEN):3 I '$T D Q
  1. . W !!,*7,"Someone else is editing this Payer Entry."
  1. . W !,"Try again later."
  1. . D PAUSE^VALM1
  1. ;
  1. ; Let the user edit the payer entry
  1. S DIE="^RCY(344.6,"
  1. W !!,"Edit flags for payer : "_$$GET1^DIQ(344.6,PIEN_",",.01,"E"),!
  1. S DA=PIEN
  1. S DR=".09Pharmacy Flag;.1Tricare Flag;.15CHAMPVA Flag" ;Add CHAMPVA PRCA*4.5*4.32
  1. D ^DIE
  1. ;
  1. L -^RCY(344.6,PIEN)
  1. D GET1PAY(PIEN,+SEL)
  1. D BLD1PAY(+SEL)
  1. Q
  1. ;
  1. SELENT(FULL,PROMPT,START,END,PCNT,WLIST,MULT) ; EP - Protocol Action
  1. ; Select Entry(s) to perform an action upon
  1. ; Called from protocols : RCDPE PAYER FLAGS EDIT
  1. ; RCDPE PAYER FLAG PHARM
  1. ; RCDPE PAYER FLAG TRIC
  1. ; Input: FULL - 1 - full screen mode, 0 otherwise
  1. ; PROMPT - Prompt to be displayed to the user
  1. ; START - Starting selection value
  1. ; END - Ending selection value
  1. ; WLIST - Worklist, the user is selecting from
  1. ; Optional, defaults to 'RCDPEPIX'
  1. ; MULT - 1 to allow multiple selection,
  1. ; 0 or null otherwise
  1. ; Optional defaults to 0
  1. ; Output: PCNT - Selected Phone Book Entry line(s)
  1. ; Returns: Selected Payer Entry IEN(s)
  1. ; Error message if invalid selection
  1. N CTR,DIROUT,DIRUT,DLINE,DTOUT,DUOUT,PIEN,PIENS,X,XX,Y,YY
  1. S:'$D(WLIST) WLIST="RCDPEPIX"
  1. S:'$D(MULT) MULT=0
  1. D:FULL FULL^VALM1
  1. ; Check for multi-selection
  1. S PCNT=$$PARSEL($G(XQORNOD(0)),START,END)
  1. ;
  1. ; W !!!,"PCNT="_PCNT_" MULT="_MULT H 10
  1. I 'MULT,$P(PCNT,",",2) D Q "" ; Invalid multi-selection
  1. . W !,*7,">>>> Only single entry selection is allowed"
  1. . K DIR
  1. . D PAUSE^VALM1
  1. S:PCNT="" PCNT=$$SELENTRY(PROMPT,START,END,MULT)
  1. Q:'PCNT ""
  1. ;
  1. S PIENS=""
  1. F CTR=1:1:$L(PCNT,",") D
  1. . S XX=$P(PCNT,",",CTR)
  1. . I XX'="" D ;
  1. . . S YY=$P(^TMP($J,WLIST,XX),"^",1)
  1. . . S PIENS=$S(PIENS="":YY,1:PIENS_","_YY)
  1. Q PIENS
  1. ;
  1. SELENTRY(PROMPT,START,END,MULT) ; Select a line
  1. ; Input: PROMPT - Prompt to be displayed to the user
  1. ; START - Start comment # that can be selected
  1. ; END - Ending comment # that can be selected
  1. ; MULT - 1=Multiple selection allowed, 0=otherwise
  1. ; Returns: Selected Comment # or "" if not selected
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1. S MULT=+$G(MULT)
  1. S DIR(0)=$S(MULT:"L",1:"N")_"O^"_START_":"_END_":0"
  1. S DIR("A")=PROMPT
  1. D ^DIR K DIR
  1. Q Y
  1. ;
  1. FLAGP ; EP - for RCDPE PAYER FLAG PHARM protocol
  1. ; Toggle pharmacy flag on selected lines
  1. ; Input: None
  1. ; Output: None
  1. D FLAG("P")
  1. Q
  1. ;
  1. FLAGT ; EP - for RCDPE PAYER FLAG TRIC protocol
  1. ; Toggle Tricare flag on selected lines
  1. ; Input: None
  1. ; Output: None
  1. D FLAG("T")
  1. Q
  1. ;
  1. FLAGC ; EP - for RCDPE PAYER FLAG CVA protocol ; Add CHAMPVA flag PRCA*4.5*432
  1. ; Toggle CHAMPVA flag on selected lines
  1. ; Input: None
  1. ; Output: None
  1. D FLAG("C")
  1. Q
  1. ;
  1. FLAG(TYPE) ; Flag a list of entries as Pharmacy or Tricare or CHAMPVA
  1. ; Input: TYPE - P=Pharmacy, T=Tricare, C=CHAMPVA
  1. ; Output: File 344.6 is updated
  1. ; ListMan array is updated
  1. N CONTINUE,CTR,FIELD,PERR,PIEN,PIENS,PROMPT,SELS,STOP,XX,ZS,ZZ
  1. S FIELD=$S(TYPE="P":.09,TYPE="T":.1,1:.15) ;Add CHAMPVA PRCA*4.5*432
  1. S VALMBCK="R"
  1. ; Check security key for edit access
  1. I '$$CHKKEY() Q ;
  1. ;
  1. S PROMPT="Select lines on which to toggle "
  1. S PROMPT=PROMPT_$S(TYPE="P":"Pharmacy",TYPE="T":"Tricare",1:"CHAMPVA")_" Flag" ;Add CHAMPVA PRCA*4.5*432
  1. S PIENS=$$SELENT(1,PROMPT,VALMBG,VALMLST,.SELS,"RCDPEPIX",1)
  1. Q:PIENS="" ;
  1. S (PERR,PIEN,ZZ,ZS)=""
  1. ;
  1. ; First lock all entries to be deleted
  1. F CTR=1:1:$L(PIENS,",") D
  1. . S PIEN=$P(PIENS,",",CTR) I PIEN="" Q ;
  1. . S XX=$P(SELS,",",CTR)
  1. . ;
  1. . ; Lock this payer exclusion for editing
  1. . L +^RCY(344.6,PIEN):3 I '$T D Q
  1. . . S PERR=$S(PERR="":XX,1:PERR_","_XX)
  1. . S ZZ=$S(ZZ="":PIEN,1:ZZ_","_PIEN)
  1. . S ZS=$S(ZS="":XX,1:ZS_","_XX)
  1. S PIENS=ZZ ; Entry(s) that can be deleted
  1. S SELS=ZS
  1. ;
  1. ; Did we lock at least one entry?
  1. I PIENS="" D Q
  1. . W !!,*7,"All entries are being edited by another user - Nothing done."
  1. . D PAUSE^VALM1
  1. ;
  1. ; Next warn the user if we couldn't lock them all
  1. I PERR'="" D Q:STOP
  1. . S STOP=0
  1. . W !!,*7,"Warning: The following entries: ",PERR," are being edited by another user"
  1. . W !,"These entries will not be updated."
  1. . S CONTINUE=$$ASKYN("Continue with update of other payers?")
  1. . I 'CONTINUE D
  1. . . S STOP=1
  1. . . F CTR=1:1:$L(PIENS,",") D
  1. . . . S PIEN=$P(PIENS,",",CTR)
  1. . . . L -^RCY(344.6,PIEN)
  1. ;
  1. ; Flag selected entries
  1. F CTR=1:1:$L(PIENS,",") D ;
  1. . N FDA,IENS,OLDVAL,VALUE
  1. . S PIEN=$P(PIENS,",",CTR)
  1. . S IENS=PIEN_","
  1. . S SEL=$P(SELS,",",CTR)
  1. . S OLDVAL=$$GET1^DIQ(344.6,IENS,FIELD,"I")
  1. . S VALUE=$S('OLDVAL:1,1:0)
  1. . S FDA(344.6,IENS,FIELD)=VALUE
  1. . L -^RCY(344.6,PIEN)
  1. . D FILE^DIE("","FDA")
  1. . D GET1PAY(PIEN,SEL)
  1. . D BLD1PAY(SEL)
  1. Q
  1. ;
  1. FILTER ; EP - for RCDPE PAYER FLAGS FILTER protocol
  1. ; Change the filter from a protocol
  1. ; Inputs - None
  1. ; Output - Sets variables FILTER and DATEFILT
  1. N NEWDATE,NEWFILT
  1. S VALMBCK="R"
  1. D FULL^VALM1
  1. S NEWDATE=$$GETDATE()
  1. I NEWDATE=-1 Q ;
  1. S NEWFILT=$$GETFILT()
  1. I NEWFILT=-1 Q ;
  1. S DATEFILT=NEWDATE
  1. S FILTER=NEWFILT
  1. D HDR,INIT
  1. Q
  1. ;
  1. PARSEL(VALMNOD,BEG,END) ; -- split out pre-answers from user
  1. ; Inputs - VALMNOD= User input from protocol menu including pre-answers
  1. ; BEG=Begining of the valid numeric range
  1. ; END=End of the valid numeric range
  1. ; Returns - Y=Comma separated list of valid numeric entries
  1. ;
  1. ; This code is adapted from VALM2.
  1. N I,J,L,X,Y
  1. S Y=$TR($P($P(VALMNOD,U,4),"=",2),"/\; .",",,,,,")
  1. ; Run through the list, skip invalid selections and expand ranges
  1. S X=Y,Y=""
  1. F I=1:1 S J=$P(X,",",I) Q:J="" D ;
  1. . I J'["-",J>(BEG-1),J<(END+1) S Y=Y_J_"," ; single valid selection
  1. . I J["-",J,J<$P(J,"-",2) D ;
  1. . . F L=+J:1:+$P(J,"-",2) D ;
  1. . . . I L>(BEG-1),L<(END+1) S Y=Y_L_"," ; valid selection from expanded range
  1. Q Y
  1. ;
  1. PARSED(X) ; Take a date in external format and check if it is a valid
  1. ; DATE ADDED (.03) in file 344.6
  1. ; Input - Date in External format
  1. ; Output - Date in Fileman format or 0 if the input was invalid
  1. D VAL^DIE(344.6,"+1,",.03,"",X,.RET)
  1. Q RET
  1. ;
  1. ASKYN(PROMPT,DEFAULT) ; Ask a yes/no question
  1. ; Input: PROMPT - Question to be asked
  1. ; DEFAULT - Default Answer
  1. ; 1 - YES, 0 - NO
  1. ; Optional, defaults to 0
  1. ; Returns: 1 - User answered YES, 0 othewise
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1. S:$G(DEFAULT)'=1 DEFAULT=0
  1. S DIR(0)="Y",DIR("A")=PROMPT
  1. S DIR("B")=$S(DEFAULT:"YES",1:"NO")
  1. D ^DIR
  1. Q Y
  1. ;
  1. HELP ; EP - for template RCDPE PAYER FLAGS help
  1. ; Input: None
  1. ; Output: Text from a help frame displayed to the screen
  1. N FILTER,DATEFILT,XQH
  1. S VALMBCK="R"
  1. S XQH="RCDPE PAYER FLAGS GENERAL"
  1. D EN^XQH
  1. Q
  1. ;
  1. EXIT ; -- exit code
  1. D FULL^VALM1
  1. Q