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

RCDPEUPO.m

Go to the documentation of this file. 
  1. RCDPEUPO ;ALBANY/KML - Unposted EFT Override ; 6/10/19 12:30pm
  1.  ;;4.5;Accounts Receivable;**298,332,349**;Mar 20, 1995;Build 44
  1.  ;Per VA Directive 6402, this routine should not be modified.
  1.  Q
  1.  ;
  1.  ; prca*4.5*298 - procedures built to implement the Unposted EFT Override option
  1.  ;
  1. EN ;  Display warning message when aged, unposted EFTs exist
  1.  N MSG
  1.  D OWNSKEY^XUSRB(.MSG,"RCDPE AGED PMT",DUZ)
  1.  I 'MSG(0) D NOENTRY Q
  1.  N AGEDEFTS
  1.  S AGEDEFTS=$$GETEFTS^RCDPEWLP("A",1)  ; need to examine both medical and pharmacy EFTs
  1.  D DMSGS(AGEDEFTS)
  1.  Q
  1.  ;
  1. DMSGS(CODES) ; display warning/error messages (if any)
  1.  ; Input:   CODES   
  1.  ; 1P - error condition for aged, unposted Pharmacy EFTs
  1.  ; 2P - warning condition for aged,unposted Pharmacy EFTs
  1.  ; 3P - Override exists for aged, unposted pharmacy EFTs
  1.  ; 1M - error condition for aged, unposted Medical EFTs
  1.  ; 2M - warning condition for aged, unposted Medical EFTs
  1.  ; 3M - Override exists for aged, unposted Medical EFTs
  1.  ; 1T - error condition for aged, unposted Tricare EFTs
  1.  ; 2T - warning condition for aged, unposted Tricare EFTs
  1.  ; 3T - Override exists for aged, unposted Tricare EFTs
  1.  ;  0 - no error or warning conditions
  1.  ;  possible values:
  1.  ; "1P" or "2P" or "3P" or "1M" or "2M" or "3M" or "1P^1M" or "1P^2M" or
  1.  ; "1P^3M" or "2P^1M" or "2P^2M" or "2P^3M" or "3P^1M" or "3P^2M" or "3P^3M"
  1.  I 'CODES D NONE Q
  1.  N DAYSLIMT,DIR,ERROR,I,LN,MSGTXT,OVERRIDE,S1,S2,STATE,TYPE,X,Y
  1.  S (OVERRIDE,ERROR)=0
  1.  S DIR("A",1)="Current Warning and/or Error messages for Unposted EFTs:"
  1.  S DIR("A",2)=" ",LN=2
  1.  F I=1:1 S STATE=$P(CODES,U,I) Q:STATE=""  D
  1.  . S S1=$E(STATE,1),S2=$E(STATE,2)
  1.  . I S1=1 D  ; 1 = ERROR
  1.  ..  S ERROR=1,TYPE=$G(TYPE)_S2
  1.  ..  ; Number of days an EFT can age before post prevention rules apply
  1.  ..  S DAYSLIMT=$$GET1^DIQ(344.61,1,$S(S2="M":.06,S2="P":.07,1:.13))
  1.  ..  S LN=LN+1
  1.  ..  S DIR("A",LN)="ERROR: Unposted "_$S(S2="P":"pharmacy ",S2="M":"medical ",1:"TRICARE ")
  1.  ..  S DIR("A",LN)=DIR("A",LN)_"EFTs exist that are more than "_DAYSLIMT_" days old."
  1.  ..  S LN=LN+1,DIR("A",LN)="Scratchpad creation is not allowed for newer payments."
  1.  ..  S LN=LN+1,DIR("A",LN)=" "
  1.  . I S1=2 D  ; 2 = warning
  1.  ..  S LN=LN+1
  1.  ..  S DIR("A",LN)="WARNING: Unposted "_$S(S2="P":"pharmacy ",S2="M":"medical ",1:"TRICARE ")
  1.  ..  S DIR("A",LN)=DIR("A",LN)_"EFTs exist that are more than "
  1.  ..  S DIR("A",LN)=DIR("A",LN)_$S(S2="P":21,1:14)_" days old."
  1.  ..  S LN=LN+1,DIR("A",LN)=" "
  1.  . I S1=3 D  ; OVERRIDE
  1.  ..  S OVERRIDE=OVERRIDE+1
  1.  ..  S LN=LN+1,DIR("A",LN)="An Override for "_$S(S2="P":"pharmacy ",S2="M":"medical ",1:"TRICARE ")
  1.  ..  S DIR("A",LN)=DIR("A",LN)_"is already in place."
  1.  ..  S LN=LN+1,DIR("A",LN)=" "
  1.  I OVERRIDE=3 D  Q
  1.  . S DIR(0)="EA",DIR("A")="Press ENTER to continue: "
  1.  . D ^DIR
  1.  I ERROR D
  1.  . M MSGTXT=DIR("A")
  1.  . S DIR(0)="YA"
  1.  . S LN=LN+1,DIR("A",LN)="An override will allow unrestricted scratchpad creation for one day."
  1.  . S DIR("A")="Do you want to continue (Y/N)? "
  1.  . D ^DIR
  1.  . Q:'Y
  1.  . S OVERRIDE=$$OVERRIDE(TYPE,.MSGTXT)
  1.  . I OVERRIDE D MAIL(.MSGTXT)
  1.  I 'ERROR D
  1.  . S LN=LN+1,DIR("A",LN)="There are no error conditions to override."
  1.  . S LN=LN+1,DIR("A",LN)=" ",DIR("A")="Press ENTER to continue: "
  1.  . S DIR(0)="EA" D ^DIR
  1.  Q
  1.  ;
  1. OVERRIDE(TYPE,TEXT) ; when ERROR state exists, perform the Override
  1.  ; Input:   TYPE    - "M" Medical
  1.  ;                    "P" Phamacy
  1.  ;                    "T" - Tricare
  1.  ;                    Any combination of above flags
  1.  ;          TEXT    - Warning and/or error statements; passed by reference
  1.  ; Output:  TEXT    - Additional text to be displayed with warning and/or error statements
  1.  ;                    contents of TEXT array will be in the body of the mail message
  1.  ;                    (refer to MAIL tag)
  1.  ; Returns: DONE    - 1 - OVERRIDE was performed;  0 - Override was not performed
  1.  ;
  1.  N DIR,DIRUT,DONE,DTTM,DUOUT,IENS,RCDFDA,REASON,X1,XX,Y
  1.  L +^RCY(344.61,1,0):DILOCKTM E  D NOLOCK S DONE=0 G OVERQ
  1.  S DONE=1
  1.  I TYPE="P"!(TYPE="M")!(TYPE="T") D
  1.  . S DIR(0)="EA",DIR("A",1)="An Override now exists for posting "
  1.  . S DIR("A",1)=DIR("A",1)_$S(TYPE="P":"pharmacy ",TYPE="M":"medical ",1:"TRICARE ")_"payments."
  1.  . S DIR("A",2)=" "
  1.  . S DIR("A")="Press ENTER to continue: "
  1.  . D ^DIR
  1.  I $L(TYPE)>1 D  I 'DONE G OVERQ
  1.  . S DIR(0)="SA^"
  1.  . S:TYPE["M" DIR(0)=DIR(0)_"M:Medical;"
  1.  . S:TYPE["P" DIR(0)=DIR(0)_"P:Pharmacy;"
  1.  . S:TYPE["T" DIR(0)=DIR(0)_"T:TRICARE;"
  1.  . I $L(TYPE)=3 S DIR("A")="Override for (M)edical, (P)harmacy or (T)RICARE? "
  1.  . E  D
  1.  . . S DIR("A")="Override for "
  1.  . . I (TYPE="PM")!(TYPE="MP") S DIR("A")=DIR("A")_"(M)edical or (P)harmacy? "
  1.  . . E  I (TYPE="PT")!(TYPE="TP") S DIR("A")=DIR("A")_"(P)harmacy or (T)RICARE? "
  1.  . . E  S DIR("A")=DIR("A")_"(M)edical or (T)RICARE? "
  1.  . D ^DIR
  1.  . I $D(DUOUT)!($D(DIRUT)) S DONE=0 Q
  1.  . S TYPE=Y
  1.  W !
  1.  K DIR
  1.  S DIR("A")="Reason for Override: ",DIR(0)="FA^1:50"
  1.  D ^DIR
  1.  I $D(DUOUT)!($D(DIRUT)) D  G OVERQ
  1.  . S DONE=0
  1.  . W !!,"   Need to enter a reason for Override.",!,"   Override not performed.",!
  1.  S REASON=Y,DTTM=$$NOW^XLFDT
  1.  S RCDFDA(344.61,"1,",$S(TYPE="M":20,TYPE="P":21,1:26))=DTTM
  1.  S RCDFDA(344.61,"1,",$S(TYPE="M":22,TYPE="P":23,1:27))=DUZ
  1.  S RCDFDA(344.61,"1,",$S(TYPE="M":24,TYPE="P":25,1:28))=REASON
  1.  D FILE^DIE("","RCDFDA")
  1.  ;
  1.  ; PRCA*4.5*349 - File override into Override history
  1.  K RCDFDA
  1.  S XX=$S(TYPE="M":.06,TYPE="P":.07,1:.13)
  1.  S XX=$$GET1^DIQ(344.61,"1,",XX,"I")
  1.  S IENS="+1,1,"
  1.  S RCDFDA(344.612,IENS,.01)=$P(DTTM,".")
  1.  S RCDFDA(344.612,IENS,.02)=DUZ
  1.  S RCDFDA(344.612,IENS,.03)=REASON
  1.  S RCDFDA(344.612,IENS,.04)=TYPE
  1.  S RCDFDA(344.612,IENS,.05)=XX
  1.  D UPDATE^DIE("","RCDFDA")
  1.  ;
  1.  S X1="" S X1=$O(TEXT(X1),-1)
  1.  S X1=X1+1
  1.  S TEXT(X1)=$S(TYPE="M":"Medical ",TYPE="P":"Pharmacy ",1:"TRICARE ")_"Override Details"
  1.  S X1=X1+1
  1.  S TEXT(X1)="User: "_$P($G(^VA(200,DUZ,0)),"^") S X1=X1+1
  1.  S TEXT(X1)="Date/Time: "_DTTM
  1.  S TEXT(X1)="Reason for Override: "_REASON
  1. OVERQ ;
  1.  L -^RCY(344.61,1,0)
  1.  Q DONE
  1.  ;
  1. MAIL(TEXT) ;generate mail message when OVERRIDE is implemented
  1.  ; Input:   TEXT    - Lines of text that represent the body of the mail message
  1.  ;
  1.  N ARRAY,CNT,CNT1,GLB,RCPROG1,SBJ,SUB
  1.  S RCPROG1="RCDUPEO",GLB=$NA(^TMP(RCPROG1,$J,"XMTEXT"))
  1.  ;
  1.  ;Build header
  1.  S SUB="EFT" K @GLB
  1.  S SBJ="EDI LBOX-STA# "_$P($$SITE^VASITE,"^",3)_"-Unposted EFTs Override "_$$FMTE^XLFDT($$NOW^XLFDT)
  1.  M @GLB=TEXT
  1.  N XMDUZ,XMINSTR,XMSUB,XMTEXT,XMY
  1.  S XMDUZ=DUZ,XMTEXT=GLB,XMSUB=SBJ,XMY("I:G.RCDPE AUDIT")=""
  1.  S XMINSTR("FROM")="POSTMASTER"
  1.  S XMINSTR("FLAGS")="P"
  1.  D SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY,.XMINSTR)
  1.  Q
  1.  ;
  1. CHECK(TYPE,OVERRIDE) ; Determine if override exists for today's date
  1.  ; Input:   TYPE        - "M" for medical, "P" for Pharmacy or "T" for Tricare
  1.  ;          OVERRIDE    - Passed by reference; array to hold the OVERRIDE data
  1.  ; Output:  OVERRIDE    - Returned array holding existing OVERRIDE data
  1.  K OVERRIDE
  1.  ;
  1.  ; Get MEDICAL EFT OVERRIDE (344.61, 20), PHARMACY EFT OVERRIDE (344.61, 21) or
  1.  ; TRICARE EFT OVERRIDE (344.61, 20) date dependent on type of EFTs
  1.  S OVERRIDE(TYPE)=+$$GET1^DIQ(344.61,1,$S(TYPE="M":20,TYPE="P":21,1:26),"I")
  1.  I 'OVERRIDE(TYPE) K OVERRIDE(TYPE) S OVERRIDE=0 Q
  1.  ;
  1.  ; Override does not exist for 'TODAYS' date,  post prevention rules will apply
  1.  I $P(OVERRIDE(TYPE),".")'=DT K OVERRIDE(TYPE)  S OVERRIDE=0 Q
  1.  S OVERRIDE=1
  1.  Q
  1.  ;
  1. NONE ; the system does not have any aged, unposted EFTs
  1.  N DIR
  1.  S DIR(0)="EA"
  1.  S DIR("A",1)="The sytem does not have any aged, unposted EFTs."
  1.  S DIR("A",2)="Therefore, no error conditions to override."
  1.  S DIR("A",3)=" "
  1.  S DIR("A")="Press ENTER to continue: "
  1.  D ^DIR
  1.  Q
  1.  ;
  1. NOACTION ; OVERRIDE already exists
  1.  ; Input:   TYPE    - "M" for medical, "P" for Pharmacy or "T" for Tricare
  1.  N DIR
  1.  S DIR(0)="EA"
  1.  S DIR("A",1)="An Override for "_$S(TYPE="P":"pharmacy ",TYPE="M":"medical ",1:"TRICARE ")
  1.  S DIR("A",1)=DIR("A",1)_"is already in place."
  1.  S DIR("A",2)="No action needed"
  1.  S DIR("A",3)=" "
  1.  S DIR("A")="Press ENTER to continue: "
  1.  D ^DIR
  1.  Q
  1.  ;
  1. NOENTRY ;  user is not authorized to use the option
  1.  N DIR
  1.  S DIR(0)="EA"
  1.  S DIR("A",1)="You are not authorized to use this option."
  1.  S DIR("A",2)="This option is locked with RCDPE AGED PMT key."
  1.  S DIR("A",3)=" "
  1.  S DIR("A")="Press ENTER to continue: "
  1.  D ^DIR
  1.  Q
  1.  ;
  1. NOLOCK ; entry at 344.61 cannot be locked
  1.  N DIR
  1.  S DIR(0)="EA"
  1.  S DIR("A",1)="Another user is editing the Override Parameters."
  1.  S DIR("A",2)="Try again later."
  1.  S DIR("A",3)=" "
  1.  S DIR("A")="Press ENTER to continue: "
  1.  D ^DIR
  1.  Q
  1.  ;