- 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 Feb 18, 2025@23:08:58 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