Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCBDPSNO

RCBDPSNO.m

Go to the documentation of this file.
  1. RCBDPSNO ;WISC/RFJ-patient statement (remove transaction) ;1 Mar 01
  1. ;;4.5;Accounts Receivable;**169**;Mar 20, 1995
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. ;
  1. COMMENT ; remove a comment transaction from a patient statement
  1. N DATA1,DATE,RCDATE,RCDEBTDA,RCEVENDA,RCTRANDA
  1. ;
  1. F D Q:'RCDEBTDA
  1. . W !! S RCDEBTDA=$$SELACCT^RCDPAPLM
  1. . I RCDEBTDA<1 S RCDEBTDA=0 Q
  1. . ;
  1. . ; build a list of the comments for the account
  1. . ; get the last event (patient statement) entry
  1. . S RCEVENDA=$$LASTEVNT^RCBDFST1(RCDEBTDA)
  1. . ;
  1. . W !!,"The following is a list of comment transactions since last statement date."
  1. . S DATE=+$P(RCEVENDA,"^",2) I DATE S DATE=$E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3)
  1. . W !,"Last Statement Date: ",DATE,!
  1. . ;
  1. . ; build list of comment transactions since statement date
  1. . K ^TMP("RCBDPSNO",$J)
  1. . S RCDATE=+$P(RCEVENDA,"^",2)
  1. . F S RCDATE=$O(^PRCA(433,"ATD",RCDEBTDA,RCDATE)) Q:'RCDATE D
  1. . . S RCTRANDA=0 F S RCTRANDA=$O(^PRCA(433,"ATD",RCDEBTDA,RCDATE,RCTRANDA)) Q:'RCTRANDA D
  1. . . . ; if transaction not a comment, quit
  1. . . . S DATA1=$G(^PRCA(433,RCTRANDA,1))
  1. . . . I $P(DATA1,"^",2)'=45 Q
  1. . . . W !?2,"Transaction: ",RCTRANDA
  1. . . . W ?25," bill: ",$P($P($G(^PRCA(430,+$P(^PRCA(433,RCTRANDA,0),"^",2),0)),"^"),"-",2)
  1. . . . W ?42," date: ",$E(RCDATE,4,5),"/",$E(RCDATE,6,7),"/",$E(RCDATE,2,3)
  1. . . . W ?60," ",$S($P($G(^PRCA(433,RCTRANDA,0)),"^",10):"***** OFF STATEMENT *****",1:"")
  1. . . . W !?5,"1st Line: ",$E($G(^PRCA(433,RCTRANDA,7,1,0)),1,64)
  1. . . . ; store for lookup
  1. . . . S ^TMP("RCBDPSNO",$J,RCTRANDA)=""
  1. . ;
  1. . I '$O(^TMP("RCBDPSNO",$J,0)) W !,"Account does not have any comment transactions." Q
  1. . ;
  1. . F D Q:RCTRANDA<1
  1. . . ; select comment transaction
  1. . . S RCTRANDA=$$ASKTRAN I RCTRANDA<1 Q
  1. . . ;
  1. . . ; ask to remove or add a comment transaction to patient statement
  1. . . S RCTRANDA=$$ADDREM(RCTRANDA)
  1. Q
  1. ;
  1. ;
  1. ASKTRAN() ; ask to select the comment transaction
  1. N DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
  1. S DIR(0)="NAO^"_$O(^TMP("RCBDPSNO",$J,0))_":"_$O(^TMP("RCBDPSNO",$J,9999999999),-1)_":0"
  1. S DIR("A")=" Select COMMENT Transaction: "
  1. S DIR("S")="I $D(^TMP(""RCBDPSNO"",$J,Y))"
  1. W ! D ^DIR
  1. I $G(DTOUT)!($G(DUOUT)) S Y=-1
  1. Q Y
  1. ;
  1. ;
  1. ADDREM(RCTRANDA) ; ask to add or remove from patient statement
  1. N DIR,DIQ2,DIRUT,DTOUT,DUOUT,RESULT,X,Y
  1. S DIR(0)="YO",DIR("B")="NO"
  1. S RESULT=$P($G(^PRCA(433,RCTRANDA,0)),"^",10)
  1. W !," The comment transaction is currently ",$S(RESULT:"OFF",1:"ON")," the patient statement."
  1. S DIR("A")=" Would you like to "_$S(RESULT:"ADD it to",1:"REMOVE it from")_" the patient statement "
  1. D ^DIR
  1. I $G(DTOUT)!($G(DUOUT)) Q 0
  1. ;
  1. I Y=1 D Q 1
  1. . S Y=$$EDIT433^RCBEUTRA(RCTRANDA,"10///"_$S(RESULT=1:"@",1:1)_";")
  1. . S RESULT=$P($G(^PRCA(433,RCTRANDA,0)),"^",10)
  1. . W !," Comment Transaction is now ",$S(RESULT:"OFF",1:"ON")," the patient statement."
  1. ;
  1. W !," No change, comment transaction remains ",$S(RESULT:"OFF",1:"ON")," the patient statement."
  1. Q 1