- 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 Feb 18, 2025@23:12:56 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