RCBDPSNO ;WISC/RFJ-patient statement (remove transaction) ;1 Mar 01
;;4.5;Accounts Receivable;**169**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
;
N DATA1,DATE,RCDATE,RCDEBTDA,RCEVENDA,RCTRANDA
;
F D Q:'RCDEBTDA
. W !! S RCDEBTDA=$$SELACCT^RCDPAPLM
. I RCDEBTDA<1 S RCDEBTDA=0 Q
. ;
. ; build a list of the comments for the account
. ; get the last event (patient statement) entry
. S RCEVENDA=$$LASTEVNT^RCBDFST1(RCDEBTDA)
. ;
. W !!,"The following is a list of comment transactions since last statement date."
. S DATE=+$P(RCEVENDA,"^",2) I DATE S DATE=$E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3)
. W !,"Last Statement Date: ",DATE,!
. ;
. ; build list of comment transactions since statement date
. K ^TMP("RCBDPSNO",$J)
. S RCDATE=+$P(RCEVENDA,"^",2)
. F S RCDATE=$O(^PRCA(433,"ATD",RCDEBTDA,RCDATE)) Q:'RCDATE D
. . S RCTRANDA=0 F S RCTRANDA=$O(^PRCA(433,"ATD",RCDEBTDA,RCDATE,RCTRANDA)) Q:'RCTRANDA D
. . . ; if transaction not a comment, quit
. . . S DATA1=$G(^PRCA(433,RCTRANDA,1))
. . . I $P(DATA1,"^",2)'=45 Q
. . . W !?2,"Transaction: ",RCTRANDA
. . . W ?25," bill: ",$P($P($G(^PRCA(430,+$P(^PRCA(433,RCTRANDA,0),"^",2),0)),"^"),"-",2)
. . . W ?42," date: ",$E(RCDATE,4,5),"/",$E(RCDATE,6,7),"/",$E(RCDATE,2,3)
. . . W ?60," ",$S($P($G(^PRCA(433,RCTRANDA,0)),"^",10):"***** OFF STATEMENT *****",1:"")
. . . W !?5,"1st Line: ",$E($G(^PRCA(433,RCTRANDA,7,1,0)),1,64)
. . . ; store for lookup
. . . S ^TMP("RCBDPSNO",$J,RCTRANDA)=""
. ;
. I '$O(^TMP("RCBDPSNO",$J,0)) W !,"Account does not have any comment transactions." Q
. ;
. F D Q:RCTRANDA<1
. . ; select comment transaction
. . S RCTRANDA=$$ASKTRAN I RCTRANDA<1 Q
. . ;
. . ; ask to remove or add a comment transaction to patient statement
. . S RCTRANDA=$$ADDREM(RCTRANDA)
Q
;
;
ASKTRAN() ; ask to select the comment transaction
N DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="NAO^"_$O(^TMP("RCBDPSNO",$J,0))_":"_$O(^TMP("RCBDPSNO",$J,9999999999),-1)_":0"
S DIR("A")=" Select COMMENT Transaction: "
S DIR("S")="I $D(^TMP(""RCBDPSNO"",$J,Y))"
W ! D ^DIR
I $G(DTOUT)!($G(DUOUT)) S Y=-1
Q Y
;
;
ADDREM(RCTRANDA) ; ask to add or remove from patient statement
N DIR,DIQ2,DIRUT,DTOUT,DUOUT,RESULT,X,Y
S DIR(0)="YO",DIR("B")="NO"
S RESULT=$P($G(^PRCA(433,RCTRANDA,0)),"^",10)
W !," The comment transaction is currently ",$S(RESULT:"OFF",1:"ON")," the patient statement."
S DIR("A")=" Would you like to "_$S(RESULT:"ADD it to",1:"REMOVE it from")_" the patient statement "
D ^DIR
I $G(DTOUT)!($G(DUOUT)) Q 0
;
I Y=1 D Q 1
. S Y=$$EDIT433^RCBEUTRA(RCTRANDA,"10///"_$S(RESULT=1:"@",1:1)_";")
. S RESULT=$P($G(^PRCA(433,RCTRANDA,0)),"^",10)
. W !," Comment Transaction is now ",$S(RESULT:"OFF",1:"ON")," the patient statement."
;
W !," No change, comment transaction remains ",$S(RESULT:"OFF",1:"ON")," the patient statement."
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCBDPSNO 3181 printed Dec 13, 2024@01:42:34 Page 2
RCBDPSNO ;WISC/RFJ-patient statement (remove transaction) ;1 Mar 01
+1 ;;4.5;Accounts Receivable;**169**;Mar 20, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ;
+1 NEW DATA1,DATE,RCDATE,RCDEBTDA,RCEVENDA,RCTRANDA
+2 ;
+3 FOR
Begin DoDot:1
+4 WRITE !!
SET RCDEBTDA=$$SELACCT^RCDPAPLM
+5 IF RCDEBTDA<1
SET RCDEBTDA=0
QUIT
+6 ;
+7 ; build a list of the comments for the account
+8 ; get the last event (patient statement) entry
+9 SET RCEVENDA=$$LASTEVNT^RCBDFST1(RCDEBTDA)
+10 ;
+11 WRITE !!,"The following is a list of comment transactions since last statement date."
+12 SET DATE=+$PIECE(RCEVENDA,"^",2)
IF DATE
SET DATE=$EXTRACT(DATE,4,5)_"/"_$EXTRACT(DATE,6,7)_"/"_$EXTRACT(DATE,2,3)
+13 WRITE !,"Last Statement Date: ",DATE,!
+14 ;
+15 ; build list of comment transactions since statement date
+16 KILL ^TMP("RCBDPSNO",$JOB)
+17 SET RCDATE=+$PIECE(RCEVENDA,"^",2)
+18 FOR
SET RCDATE=$ORDER(^PRCA(433,"ATD",RCDEBTDA,RCDATE))
if 'RCDATE
QUIT
Begin DoDot:2
+19 SET RCTRANDA=0
FOR
SET RCTRANDA=$ORDER(^PRCA(433,"ATD",RCDEBTDA,RCDATE,RCTRANDA))
if 'RCTRANDA
QUIT
Begin DoDot:3
+20 ; if transaction not a comment, quit
+21 SET DATA1=$GET(^PRCA(433,RCTRANDA,1))
+22 IF $PIECE(DATA1,"^",2)'=45
QUIT
+23 WRITE !?2,"Transaction: ",RCTRANDA
+24 WRITE ?25," bill: ",$PIECE($PIECE($GET(^PRCA(430,+$PIECE(^PRCA(433,RCTRANDA,0),"^",2),0)),"^"),"-",2)
+25 WRITE ?42," date: ",$EXTRACT(RCDATE,4,5),"/",$EXTRACT(RCDATE,6,7),"/",$EXTRACT(RCDATE,2,3)
+26 WRITE ?60," ",$SELECT($PIECE($GET(^PRCA(433,RCTRANDA,0)),"^",10):"***** OFF STATEMENT *****",1:"")
+27 WRITE !?5,"1st Line: ",$EXTRACT($GET(^PRCA(433,RCTRANDA,7,1,0)),1,64)
+28 ; store for lookup
+29 SET ^TMP("RCBDPSNO",$JOB,RCTRANDA)=""
End DoDot:3
End DoDot:2
+30 ;
+31 IF '$ORDER(^TMP("RCBDPSNO",$JOB,0))
WRITE !,"Account does not have any comment transactions."
QUIT
+32 ;
+33 FOR
Begin DoDot:2
+34 ; select comment transaction
+35 SET RCTRANDA=$$ASKTRAN
IF RCTRANDA<1
QUIT
+36 ;
+37 ; ask to remove or add a comment transaction to patient statement
+38 SET RCTRANDA=$$ADDREM(RCTRANDA)
End DoDot:2
if RCTRANDA<1
QUIT
End DoDot:1
if 'RCDEBTDA
QUIT
+39 QUIT
+40 ;
+41 ;
ASKTRAN() ; ask to select the comment transaction
+1 NEW DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
+2 SET DIR(0)="NAO^"_$ORDER(^TMP("RCBDPSNO",$JOB,0))_":"_$ORDER(^TMP("RCBDPSNO",$JOB,9999999999),-1)_":0"
+3 SET DIR("A")=" Select COMMENT Transaction: "
+4 SET DIR("S")="I $D(^TMP(""RCBDPSNO"",$J,Y))"
+5 WRITE !
DO ^DIR
+6 IF $GET(DTOUT)!($GET(DUOUT))
SET Y=-1
+7 QUIT Y
+8 ;
+9 ;
ADDREM(RCTRANDA) ; ask to add or remove from patient statement
+1 NEW DIR,DIQ2,DIRUT,DTOUT,DUOUT,RESULT,X,Y
+2 SET DIR(0)="YO"
SET DIR("B")="NO"
+3 SET RESULT=$PIECE($GET(^PRCA(433,RCTRANDA,0)),"^",10)
+4 WRITE !," The comment transaction is currently ",$SELECT(RESULT:"OFF",1:"ON")," the patient statement."
+5 SET DIR("A")=" Would you like to "_$SELECT(RESULT:"ADD it to",1:"REMOVE it from")_" the patient statement "
+6 DO ^DIR
+7 IF $GET(DTOUT)!($GET(DUOUT))
QUIT 0
+8 ;
+9 IF Y=1
Begin DoDot:1
+10 SET Y=$$EDIT433^RCBEUTRA(RCTRANDA,"10///"_$SELECT(RESULT=1:"@",1:1)_";")
+11 SET RESULT=$PIECE($GET(^PRCA(433,RCTRANDA,0)),"^",10)
+12 WRITE !," Comment Transaction is now ",$SELECT(RESULT:"OFF",1:"ON")," the patient statement."
End DoDot:1
QUIT 1
+13 ;
+14 WRITE !," No change, comment transaction remains ",$SELECT(RESULT:"OFF",1:"ON")," the patient statement."
+15 QUIT 1
