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

RCDPECH.m

Go to the documentation of this file. 
  1. RCDPECH ;ALB/PJH - RECEIPT COMMENT HISTORY ;24-FEB-03
  1.  ;;4.5;Accounts Receivable;**173,276,321**;Mar 20, 1995;Build 48
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  Q
  1.  ;
  1. AUDIT(RCRCPT,RCLINE,RCZ,RCR) ;EP store entry in RCDPE COMMENT HISTORY
  1.  ;Input
  1.  ; RCRCPT - Receipt IEN #344
  1.  ; RCLINE - Receipt line number
  1.  ; RCZ    - Scratchpad IEN (optional)
  1.  ; RCR    - Scratchpad line number (optional)
  1.  ;Output
  1.  ; Write record to #344.73 - RCDPE COMMENT HISTORY
  1.  ;
  1.  Q:'$G(RCRCPT)
  1.  Q:'$G(RCLINE)
  1.  ;
  1.  N RCCOM,RCDATE,RCUSER
  1.  ; Use scratchpad as data source if passed
  1.  I $G(RCZ),$G(RCR) D  Q:RCCOM=""
  1.  . S RCCOM=$$GET1^DIQ(344.491,RCR_","_RCZ_",",.1)
  1.  . S RCUSER=$$GET1^DIQ(344.491,RCR_","_RCZ_",",2.03,"I")
  1.  . S RCDATE=$$GET1^DIQ(344.491,RCR_","_RCZ_",",2.04,"I")
  1.  ; Otherwise use receipt fields and current user/time
  1.  E  D  Q:RCCOM=""
  1.  . S RCDATE=$$NOW^XLFDT
  1.  . S RCCOM=$$GET1^DIQ(344.01,RCLINE_","_RCRCPT_",",1.02)
  1.  . S RCUSER=DUZ
  1.  ; Use current date if original date is not found
  1.  I 'RCDATE S RCDATE=$$NOW^XLFDT
  1.  ; Use current user if original user not found
  1.  I 'RCUSER S RCUSER=DUZ
  1.  ;
  1.  N RCAUDIT
  1.  ;
  1.  ; Set up array for UPDATE^DIE
  1.  S RCAUDIT(344.73,"+1,",.01)=RCRCPT ;Receipt
  1.  S RCAUDIT(344.73,"+1,",1)=RCLINE   ;Receipt line number
  1.  S RCAUDIT(344.73,"+1,",2)=RCUSER   ;User
  1.  S RCAUDIT(344.73,"+1,",3)=RCDATE   ;Date
  1.  S RCAUDIT(344.73,"+1,",4)=RCCOM    ;Comment
  1.  ;
  1.  ; Update file
  1.  D UPDATE^DIE(,"RCAUDIT")
  1.  Q
  1.  ;
  1. GET(RETURN,RCRCPT,RCLINE) ;EP Get comment history for a receipt
  1.  ;Input
  1.  ; RCRCPT - Receipt IEN
  1.  ; RCLINE - Receipt line number
  1.  ;Output
  1.  ; RETURN(N) = Date ^ User Name ^ Comment text
  1.  ;
  1.  Q:'$G(RCRCPT)  Q:'$G(RCLINE)
  1.  ;
  1.  N RCCOMM,RCDA,RCDATE,RCCDT,RCUSER
  1.  ; Return comments - most recent first in return array
  1.  S RETURN=0,RCCDT=9999999
  1.  F  S RCCDT=$O(^RCY(344.73,"AC",RCRCPT,RCLINE,RCCDT),-1) Q:'RCCDT  D
  1.  . S RCDA=$G(^RCY(344.73,"AC",RCRCPT,RCLINE,RCCDT)) Q:'RCDA
  1.  . ; Get comments and user details
  1.  . S RCCOM=$$GET1^DIQ(344.73,RCDA_",",4)
  1.  . S RCUSER=$$GET1^DIQ(344.73,RCDA_",",2,"E")
  1.  . S RCDATE=$$GET1^DIQ(344.73,RCDA_",",3,"E")
  1.  . S RETURN=RETURN+1,RETURN(RETURN)=RCDATE_U_RCUSER_U_RCCOM
  1.  Q
  1.  ;
  1. COM() ;EP Receipt line comment entry
  1.  ;
  1.  ;Output
  1.  ; Y - Comment text (3 - 60 characters)
  1.  ;     or -1 = abort/timeout
  1.  ;
  1.  N DIR,DIRUT,DTOUT,DUOUT,X,Y
  1.  S DIR("A")="COMMENT: "
  1.  S DIR(0)="SA^1:Collected/Closed;2:Cancelled;3:Returned refund;4:Overpayment;5:Inactive bill;"
  1.  S DIR(0)=DIR(0)_"6:Duplicate payment;7:Policy termed;8:Service connected;9:Other"
  1.  D ^DIR Q:$D(DTOUT)!$D(DUOUT) -1
  1.  ; If selection is not 'Other' use selection as comment text
  1.  I Y'=9 S Y=Y(0) Q Y
  1.  ; Otherwise force entry of free text comment of 3 to 60 characters 
  1.  F  D  Q:Y'=""
  1.  . S DIR(0)="344.491,.1A",DIR("A")=" COMMENT TEXT: "
  1.  . D ^DIR
  1.  . I $D(DTOUT)!$D(DUOUT) S Y=-1 Q
  1.  . ; Remove leading or trailing spaces
  1.  . S Y=$$TRIM^XLFSTR(X)
  1.  . I (Y="")!(Y="@") D
  1.  . . W !,"A comment is required when changing the status of an item in suspense, Please"
  1.  . . W !,"try again"
  1.  . . S:Y="@" Y=""
  1.  Q Y