source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCBDPSNO.m@ 1692

Last change on this file since 1692 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.0 KB
Line 
1RCBDPSNO ;WISC/RFJ-patient statement (remove transaction) ;1 Mar 01
2 ;;4.5;Accounts Receivable;**169**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;
6COMMENT ; remove a comment transaction from a patient statement
7 N DATA1,DATE,RCDATE,RCDEBTDA,RCEVENDA,RCTRANDA
8 ;
9 F D Q:'RCDEBTDA
10 . W !! S RCDEBTDA=$$SELACCT^RCDPAPLM
11 . I RCDEBTDA<1 S RCDEBTDA=0 Q
12 . ;
13 . ; build a list of the comments for the account
14 . ; get the last event (patient statement) entry
15 . S RCEVENDA=$$LASTEVNT^RCBDFST1(RCDEBTDA)
16 . ;
17 . W !!,"The following is a list of comment transactions since last statement date."
18 . S DATE=+$P(RCEVENDA,"^",2) I DATE S DATE=$E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3)
19 . W !,"Last Statement Date: ",DATE,!
20 . ;
21 . ; build list of comment transactions since statement date
22 . K ^TMP("RCBDPSNO",$J)
23 . S RCDATE=+$P(RCEVENDA,"^",2)
24 . F S RCDATE=$O(^PRCA(433,"ATD",RCDEBTDA,RCDATE)) Q:'RCDATE D
25 . . S RCTRANDA=0 F S RCTRANDA=$O(^PRCA(433,"ATD",RCDEBTDA,RCDATE,RCTRANDA)) Q:'RCTRANDA D
26 . . . ; if transaction not a comment, quit
27 . . . S DATA1=$G(^PRCA(433,RCTRANDA,1))
28 . . . I $P(DATA1,"^",2)'=45 Q
29 . . . W !?2,"Transaction: ",RCTRANDA
30 . . . W ?25," bill: ",$P($P($G(^PRCA(430,+$P(^PRCA(433,RCTRANDA,0),"^",2),0)),"^"),"-",2)
31 . . . W ?42," date: ",$E(RCDATE,4,5),"/",$E(RCDATE,6,7),"/",$E(RCDATE,2,3)
32 . . . W ?60," ",$S($P($G(^PRCA(433,RCTRANDA,0)),"^",10):"***** OFF STATEMENT *****",1:"")
33 . . . W !?5,"1st Line: ",$E($G(^PRCA(433,RCTRANDA,7,1,0)),1,64)
34 . . . ; store for lookup
35 . . . S ^TMP("RCBDPSNO",$J,RCTRANDA)=""
36 . ;
37 . I '$O(^TMP("RCBDPSNO",$J,0)) W !,"Account does not have any comment transactions." Q
38 . ;
39 . F D Q:RCTRANDA<1
40 . . ; select comment transaction
41 . . S RCTRANDA=$$ASKTRAN I RCTRANDA<1 Q
42 . . ;
43 . . ; ask to remove or add a comment transaction to patient statement
44 . . S RCTRANDA=$$ADDREM(RCTRANDA)
45 Q
46 ;
47 ;
48ASKTRAN() ; ask to select the comment transaction
49 N DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
50 S DIR(0)="NAO^"_$O(^TMP("RCBDPSNO",$J,0))_":"_$O(^TMP("RCBDPSNO",$J,9999999999),-1)_":0"
51 S DIR("A")=" Select COMMENT Transaction: "
52 S DIR("S")="I $D(^TMP(""RCBDPSNO"",$J,Y))"
53 W ! D ^DIR
54 I $G(DTOUT)!($G(DUOUT)) S Y=-1
55 Q Y
56 ;
57 ;
58ADDREM(RCTRANDA) ; ask to add or remove from patient statement
59 N DIR,DIQ2,DIRUT,DTOUT,DUOUT,RESULT,X,Y
60 S DIR(0)="YO",DIR("B")="NO"
61 S RESULT=$P($G(^PRCA(433,RCTRANDA,0)),"^",10)
62 W !," The comment transaction is currently ",$S(RESULT:"OFF",1:"ON")," the patient statement."
63 S DIR("A")=" Would you like to "_$S(RESULT:"ADD it to",1:"REMOVE it from")_" the patient statement "
64 D ^DIR
65 I $G(DTOUT)!($G(DUOUT)) Q 0
66 ;
67 I Y=1 D Q 1
68 . S Y=$$EDIT433^RCBEUTRA(RCTRANDA,"10///"_$S(RESULT=1:"@",1:1)_";")
69 . S RESULT=$P($G(^PRCA(433,RCTRANDA,0)),"^",10)
70 . W !," Comment Transaction is now ",$S(RESULT:"OFF",1:"ON")," the patient statement."
71 ;
72 W !," No change, comment transaction remains ",$S(RESULT:"OFF",1:"ON")," the patient statement."
73 Q 1
Note: See TracBrowser for help on using the repository browser.