RCDPTPLM ;WISC/RFJ-transaction profile listmanager top routine ;1 Jun 99
;;4.5;Accounts Receivable;**114,198**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
; called from menu option (19)
;
N RCTRANDA,RCDPFXIT
;
F D Q:'RCTRANDA
. W !! S RCTRANDA=$$SELTRAN
. I RCTRANDA<1 S RCTRANDA=0 Q
. ;
. ; check for transaction incomplete, do not enter lm
. I $P($G(^PRCA(433,RCTRANDA,0)),"^",4)=1 D Q
. . W !!," This transaction is INCOMPLETE. The transaction must be complete"
. . W !," before running this option."
. ;
. D EN^VALM("RCDP TRANS PROFILE")
. ; fast exit
. I $G(RCDPFXIT) S RCTRANDA=0
Q
;
;
INIT ; initialization for list manager list
; requires rctranda
; fast exit
I $G(RCDPFXIT) S VALMQUIT=1 Q
D INIT^RCDPTPLI
D HDR
Q
;
;
HDR ; header code for list manager display
N RCBILLDA,RCTOTAL
S RCBILLDA=$P($G(^PRCA(433,RCTRANDA,0)),"^",2)
S RCTOTAL=$$BILLBAL^RCRJRCOB(RCBILLDA,DT)
D HDR^RCDPBTLM
Q
;
;
EXIT ; exit list manager option and clean up
K ^TMP("RCDPTPLM",$J),^TMP("RCDPBTLMX",$J)
Q
;
;
SELTRAN() ; select a transaction
; returns -1 for timeout or ^, 0 for no selection, or ien of trans
N %,%Y,C,DIC,DTOUT,DUOUT,X,Y
N DPTNOFZY,DPTNOFZK S (DPTNOFZY,DPTNOFZK)=1
S DIC="^PRCA(433,",DIC(0)="QEAM",DIC("A")="Select TRANSACTION: "
D ^DIC
I Y<0,'$G(DUOUT),'$G(DTOUT) S Y=0
Q +Y
;
;
DIQ433(DA,DR) ; diq call to retrieve data for dr fields in file 433
N D0,DIC,DIQ,DIQ2
K RCDPDATA(433,DA)
S DIQ(0)="IE",DIC="^PRCA(433,",DIQ="RCDPDATA" D EN^DIQ1
Q
;
;
NEWTRANS ; select a new transaction
D FULL^VALM1
S VALMBCK="R"
;
W !!,"This option will allow you to select a new transaction to display."
W ! S %=$$SELTRAN
I %<1 Q
S RCTRANDA=%
;
; if called from bill profile, pick new bill
I $D(^TMP("RCDPBPLM",$J)) S RCBILLDA=$P(^PRCA(433,RCTRANDA,0),"^",2)
; if called from account profile, pick new account
I $D(^TMP("RCDPAPLM",$J)),RCBILLDA S RCDEBTDA=$P(^PRCA(430,RCBILLDA,0),"^",9)
;
D INIT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPTPLM 2115 printed Dec 13, 2024@01:46:33 Page 2
RCDPTPLM ;WISC/RFJ-transaction profile listmanager top routine ;1 Jun 99
+1 ;;4.5;Accounts Receivable;**114,198**;Mar 20, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ; called from menu option (19)
+5 ;
+6 NEW RCTRANDA,RCDPFXIT
+7 ;
+8 FOR
Begin DoDot:1
+9 WRITE !!
SET RCTRANDA=$$SELTRAN
+10 IF RCTRANDA<1
SET RCTRANDA=0
QUIT
+11 ;
+12 ; check for transaction incomplete, do not enter lm
+13 IF $PIECE($GET(^PRCA(433,RCTRANDA,0)),"^",4)=1
Begin DoDot:2
+14 WRITE !!," This transaction is INCOMPLETE. The transaction must be complete"
+15 WRITE !," before running this option."
End DoDot:2
QUIT
+16 ;
+17 DO EN^VALM("RCDP TRANS PROFILE")
+18 ; fast exit
+19 IF $GET(RCDPFXIT)
SET RCTRANDA=0
End DoDot:1
if 'RCTRANDA
QUIT
+20 QUIT
+21 ;
+22 ;
INIT ; initialization for list manager list
+1 ; requires rctranda
+2 ; fast exit
+3 IF $GET(RCDPFXIT)
SET VALMQUIT=1
QUIT
+4 DO INIT^RCDPTPLI
+5 DO HDR
+6 QUIT
+7 ;
+8 ;
HDR ; header code for list manager display
+1 NEW RCBILLDA,RCTOTAL
+2 SET RCBILLDA=$PIECE($GET(^PRCA(433,RCTRANDA,0)),"^",2)
+3 SET RCTOTAL=$$BILLBAL^RCRJRCOB(RCBILLDA,DT)
+4 DO HDR^RCDPBTLM
+5 QUIT
+6 ;
+7 ;
EXIT ; exit list manager option and clean up
+1 KILL ^TMP("RCDPTPLM",$JOB),^TMP("RCDPBTLMX",$JOB)
+2 QUIT
+3 ;
+4 ;
SELTRAN() ; select a transaction
+1 ; returns -1 for timeout or ^, 0 for no selection, or ien of trans
+2 NEW %,%Y,C,DIC,DTOUT,DUOUT,X,Y
+3 NEW DPTNOFZY,DPTNOFZK
SET (DPTNOFZY,DPTNOFZK)=1
+4 SET DIC="^PRCA(433,"
SET DIC(0)="QEAM"
SET DIC("A")="Select TRANSACTION: "
+5 DO ^DIC
+6 IF Y<0
IF '$GET(DUOUT)
IF '$GET(DTOUT)
SET Y=0
+7 QUIT +Y
+8 ;
+9 ;
DIQ433(DA,DR) ; diq call to retrieve data for dr fields in file 433
+1 NEW D0,DIC,DIQ,DIQ2
+2 KILL RCDPDATA(433,DA)
+3 SET DIQ(0)="IE"
SET DIC="^PRCA(433,"
SET DIQ="RCDPDATA"
DO EN^DIQ1
+4 QUIT
+5 ;
+6 ;
NEWTRANS ; select a new transaction
+1 DO FULL^VALM1
+2 SET VALMBCK="R"
+3 ;
+4 WRITE !!,"This option will allow you to select a new transaction to display."
+5 WRITE !
SET %=$$SELTRAN
+6 IF %<1
QUIT
+7 SET RCTRANDA=%
+8 ;
+9 ; if called from bill profile, pick new bill
+10 IF $DATA(^TMP("RCDPBPLM",$JOB))
SET RCBILLDA=$PIECE(^PRCA(433,RCTRANDA,0),"^",2)
+11 ; if called from account profile, pick new account
+12 IF $DATA(^TMP("RCDPAPLM",$JOB))
IF RCBILLDA
SET RCDEBTDA=$PIECE(^PRCA(430,RCBILLDA,0),"^",9)
+13 ;
+14 DO INIT
+15 QUIT
