RCDPECH ;ALB/PJH - RECEIPT COMMENT HISTORY ;24-FEB-03
;;4.5;Accounts Receivable;**173,276,321**;Mar 20, 1995;Build 48
;;Per VHA Directive 2004-038, this routine should not be modified.
Q
;
AUDIT(RCRCPT,RCLINE,RCZ,RCR) ;EP store entry in RCDPE COMMENT HISTORY
;Input
; RCRCPT - Receipt IEN #344
; RCLINE - Receipt line number
; RCZ - Scratchpad IEN (optional)
; RCR - Scratchpad line number (optional)
;Output
; Write record to #344.73 - RCDPE COMMENT HISTORY
;
Q:'$G(RCRCPT)
Q:'$G(RCLINE)
;
N RCCOM,RCDATE,RCUSER
; Use scratchpad as data source if passed
I $G(RCZ),$G(RCR) D Q:RCCOM=""
. S RCCOM=$$GET1^DIQ(344.491,RCR_","_RCZ_",",.1)
. S RCUSER=$$GET1^DIQ(344.491,RCR_","_RCZ_",",2.03,"I")
. S RCDATE=$$GET1^DIQ(344.491,RCR_","_RCZ_",",2.04,"I")
; Otherwise use receipt fields and current user/time
E D Q:RCCOM=""
. S RCDATE=$$NOW^XLFDT
. S RCCOM=$$GET1^DIQ(344.01,RCLINE_","_RCRCPT_",",1.02)
. S RCUSER=DUZ
; Use current date if original date is not found
I 'RCDATE S RCDATE=$$NOW^XLFDT
; Use current user if original user not found
I 'RCUSER S RCUSER=DUZ
;
N RCAUDIT
;
; Set up array for UPDATE^DIE
S RCAUDIT(344.73,"+1,",.01)=RCRCPT ;Receipt
S RCAUDIT(344.73,"+1,",1)=RCLINE ;Receipt line number
S RCAUDIT(344.73,"+1,",2)=RCUSER ;User
S RCAUDIT(344.73,"+1,",3)=RCDATE ;Date
S RCAUDIT(344.73,"+1,",4)=RCCOM ;Comment
;
; Update file
D UPDATE^DIE(,"RCAUDIT")
Q
;
GET(RETURN,RCRCPT,RCLINE) ;EP Get comment history for a receipt
;Input
; RCRCPT - Receipt IEN
; RCLINE - Receipt line number
;Output
; RETURN(N) = Date ^ User Name ^ Comment text
;
Q:'$G(RCRCPT) Q:'$G(RCLINE)
;
N RCCOMM,RCDA,RCDATE,RCCDT,RCUSER
; Return comments - most recent first in return array
S RETURN=0,RCCDT=9999999
F S RCCDT=$O(^RCY(344.73,"AC",RCRCPT,RCLINE,RCCDT),-1) Q:'RCCDT D
. S RCDA=$G(^RCY(344.73,"AC",RCRCPT,RCLINE,RCCDT)) Q:'RCDA
. ; Get comments and user details
. S RCCOM=$$GET1^DIQ(344.73,RCDA_",",4)
. S RCUSER=$$GET1^DIQ(344.73,RCDA_",",2,"E")
. S RCDATE=$$GET1^DIQ(344.73,RCDA_",",3,"E")
. S RETURN=RETURN+1,RETURN(RETURN)=RCDATE_U_RCUSER_U_RCCOM
Q
;
COM() ;EP Receipt line comment entry
;
;Output
; Y - Comment text (3 - 60 characters)
; or -1 = abort/timeout
;
N DIR,DIRUT,DTOUT,DUOUT,X,Y
S DIR("A")="COMMENT: "
S DIR(0)="SA^1:Collected/Closed;2:Cancelled;3:Returned refund;4:Overpayment;5:Inactive bill;"
S DIR(0)=DIR(0)_"6:Duplicate payment;7:Policy termed;8:Service connected;9:Other"
D ^DIR Q:$D(DTOUT)!$D(DUOUT) -1
; If selection is not 'Other' use selection as comment text
I Y'=9 S Y=Y(0) Q Y
; Otherwise force entry of free text comment of 3 to 60 characters
F D Q:Y'=""
. S DIR(0)="344.491,.1A",DIR("A")=" COMMENT TEXT: "
. D ^DIR
. I $D(DTOUT)!$D(DUOUT) S Y=-1 Q
. ; Remove leading or trailing spaces
. S Y=$$TRIM^XLFSTR(X)
. I (Y="")!(Y="@") D
. . W !,"A comment is required when changing the status of an item in suspense, Please"
. . W !,"try again"
. . S:Y="@" Y=""
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPECH 3083 printed Apr 09, 2024@20:48:10 Page 2
RCDPECH ;ALB/PJH - RECEIPT COMMENT HISTORY ;24-FEB-03
+1 ;;4.5;Accounts Receivable;**173,276,321**;Mar 20, 1995;Build 48
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
+4 ;
AUDIT(RCRCPT,RCLINE,RCZ,RCR) ;EP store entry in RCDPE COMMENT HISTORY
+1 ;Input
+2 ; RCRCPT - Receipt IEN #344
+3 ; RCLINE - Receipt line number
+4 ; RCZ - Scratchpad IEN (optional)
+5 ; RCR - Scratchpad line number (optional)
+6 ;Output
+7 ; Write record to #344.73 - RCDPE COMMENT HISTORY
+8 ;
+9 if '$GET(RCRCPT)
QUIT
+10 if '$GET(RCLINE)
QUIT
+11 ;
+12 NEW RCCOM,RCDATE,RCUSER
+13 ; Use scratchpad as data source if passed
+14 IF $GET(RCZ)
IF $GET(RCR)
Begin DoDot:1
+15 SET RCCOM=$$GET1^DIQ(344.491,RCR_","_RCZ_",",.1)
+16 SET RCUSER=$$GET1^DIQ(344.491,RCR_","_RCZ_",",2.03,"I")
+17 SET RCDATE=$$GET1^DIQ(344.491,RCR_","_RCZ_",",2.04,"I")
End DoDot:1
if RCCOM=""
QUIT
+18 ; Otherwise use receipt fields and current user/time
+19 IF '$TEST
Begin DoDot:1
+20 SET RCDATE=$$NOW^XLFDT
+21 SET RCCOM=$$GET1^DIQ(344.01,RCLINE_","_RCRCPT_",",1.02)
+22 SET RCUSER=DUZ
End DoDot:1
if RCCOM=""
QUIT
+23 ; Use current date if original date is not found
+24 IF 'RCDATE
SET RCDATE=$$NOW^XLFDT
+25 ; Use current user if original user not found
+26 IF 'RCUSER
SET RCUSER=DUZ
+27 ;
+28 NEW RCAUDIT
+29 ;
+30 ; Set up array for UPDATE^DIE
+31 ;Receipt
SET RCAUDIT(344.73,"+1,",.01)=RCRCPT
+32 ;Receipt line number
SET RCAUDIT(344.73,"+1,",1)=RCLINE
+33 ;User
SET RCAUDIT(344.73,"+1,",2)=RCUSER
+34 ;Date
SET RCAUDIT(344.73,"+1,",3)=RCDATE
+35 ;Comment
SET RCAUDIT(344.73,"+1,",4)=RCCOM
+36 ;
+37 ; Update file
+38 DO UPDATE^DIE(,"RCAUDIT")
+39 QUIT
+40 ;
GET(RETURN,RCRCPT,RCLINE) ;EP Get comment history for a receipt
+1 ;Input
+2 ; RCRCPT - Receipt IEN
+3 ; RCLINE - Receipt line number
+4 ;Output
+5 ; RETURN(N) = Date ^ User Name ^ Comment text
+6 ;
+7 if '$GET(RCRCPT)
QUIT
if '$GET(RCLINE)
QUIT
+8 ;
+9 NEW RCCOMM,RCDA,RCDATE,RCCDT,RCUSER
+10 ; Return comments - most recent first in return array
+11 SET RETURN=0
SET RCCDT=9999999
+12 FOR
SET RCCDT=$ORDER(^RCY(344.73,"AC",RCRCPT,RCLINE,RCCDT),-1)
if 'RCCDT
QUIT
Begin DoDot:1
+13 SET RCDA=$GET(^RCY(344.73,"AC",RCRCPT,RCLINE,RCCDT))
if 'RCDA
QUIT
+14 ; Get comments and user details
+15 SET RCCOM=$$GET1^DIQ(344.73,RCDA_",",4)
+16 SET RCUSER=$$GET1^DIQ(344.73,RCDA_",",2,"E")
+17 SET RCDATE=$$GET1^DIQ(344.73,RCDA_",",3,"E")
+18 SET RETURN=RETURN+1
SET RETURN(RETURN)=RCDATE_U_RCUSER_U_RCCOM
End DoDot:1
+19 QUIT
+20 ;
COM() ;EP Receipt line comment entry
+1 ;
+2 ;Output
+3 ; Y - Comment text (3 - 60 characters)
+4 ; or -1 = abort/timeout
+5 ;
+6 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+7 SET DIR("A")="COMMENT: "
+8 SET DIR(0)="SA^1:Collected/Closed;2:Cancelled;3:Returned refund;4:Overpayment;5:Inactive bill;"
+9 SET DIR(0)=DIR(0)_"6:Duplicate payment;7:Policy termed;8:Service connected;9:Other"
+10 DO ^DIR
if $DATA(DTOUT)!$DATA(DUOUT)
QUIT -1
+11 ; If selection is not 'Other' use selection as comment text
+12 IF Y'=9
SET Y=Y(0)
QUIT Y
+13 ; Otherwise force entry of free text comment of 3 to 60 characters
+14 FOR
Begin DoDot:1
+15 SET DIR(0)="344.491,.1A"
SET DIR("A")=" COMMENT TEXT: "
+16 DO ^DIR
+17 IF $DATA(DTOUT)!$DATA(DUOUT)
SET Y=-1
QUIT
+18 ; Remove leading or trailing spaces
+19 SET Y=$$TRIM^XLFSTR(X)
+20 IF (Y="")!(Y="@")
Begin DoDot:2
+21 WRITE !,"A comment is required when changing the status of an item in suspense, Please"
+22 WRITE !,"try again"
+23 if Y="@"
SET Y=""
End DoDot:2
End DoDot:1
if Y'=""
QUIT
+24 QUIT Y
