RMPRPF3 ;HOIFO/TH,DDA - PFSS Charge Cancel (credit) ;8/18/05
 ;;3.0;PROSTHETICS;**98**;Feb 09, 1996
 ;
 ; This routine sends "Credit" Charge Message to IBB if .01 field got deleted in file 660
 ;  or if the PSAS HCPCS code is deleted (equals null after user edit).
 ; 
 ; DBIA # 4663 for SWSTAT^IBBAPI
 ; DBIA # 4665 for CHARGE^IBBAPI
 Q
 ;
CHRGTASK ; FILE #660, ENTRY DATE AND PSAS HCPCS FIELDS MUMPS XREF
 ;KILL LOGIC.
 ; TASKMAN LOAD A ONE TIME TASKMAN TASK.
 ; QUIT IF PFSS SWITCH IS OFF OR IF THERE IS NO CHARGE TO REVERSE
 Q:'+$$SWSTAT^IBBAPI()
 S RMPRPFSS=$G(^RMPR(660,DA,"PFSS"))
 Q:$P(RMPRPFSS,"^",2)=""
 S RMPRZERO=^RMPR(660,DA,0)
 N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU,ZTPRI,ZTSAVE,ZTKIL,ZTSYNC
 S ZTIO="",ZTRTN="CHRGCRED^RMPRPF3",ZTDESC="Prosthetics file #660 PFSS Charge Credit",ZTDTH=$H
 S ZTSAVE("RMPRIEN")=DA
 S ZTSAVE("RMPRZERO")=RMPRZERO
 S ZTSAVE("RMPRONE")=$G(^RMPR(660,DA,1))
 S ZTSAVE("RMPRTEN")=$G(^RMPR(660,DA,10))
 S ZTSAVE("RMPRPFSS")=RMPRPFSS
 D ^%ZTLOAD
 Q
 ;
CHRGCRED ; Process account deletion/cancellation
 ;
 ; Check if already processing this record.
 Q:$G(^TMP("RMPRPF3",RMPRIEN))=RMPRIEN
 S ^TMP("RMPRPF3",RMPRIEN)=RMPRIEN
 ; Check if this is just a Date edit or a PSAS HCPCS edit, set x-ref AND QUIT.
 S RMPRCDFL=0
 S:'$D(^RMPR(660,RMPRIEN,0)) RMPRCDFL=1
 S:$P($G(RMPRONE),"^",4)="" RMPRCDFL=1
 I RMPRCDFL=0 D SETAPD G EXIT
 ; RECORD HAS EITHER BEEN DELETED OR PSAS HCPCS HAS BEEN DELETED.  SEND A CREDIT (CD).
 S RMPRUCID=$P(RMPRPFSS,U,2)
 S RMPRTYPE="CD"
 S RMPRDFN=$P(RMPRZERO,"^",2)
 S RMPRARFN=$P(RMPRPFSS,"^")
 ;
 ; FT1
 S RMPRFT1(4)=$P(RMPRZERO,"^",12)  ; Delivery Date
 S RMPRFT1(10)=$P(RMPRZERO,"^",7)  ; Transaction Quantity
 S RMPRFT1(13)=423  ; Department Code
 S RMPRFT1(21)=$P($G(RMPRTEN),"^",6)  ; Ordering Provider/Ordered by Code
 S RMPRTC=$P(RMPRZERO,"^",16)
 S RMPRFT1(22)=RMPRTC/RMPRFT1(10)    ; Unit Cost = Total Cost/QTY
 ; PR1
 S RMPRHCPC=$P(RMPRONE,"^",4)
 S RMPRHCDT=$P(RMPRONE,"^")
 D PSASHCPC^RMPOPF
 S RMPRPR1(3)=RMPRVHC   ; Procedure Code
 S RMPRPR1(4)=RMPRTHC   ; PSAS HCPCS text
 ; Procedure Functional Type - I:Stock Issue;P:Purchasing
 S RMPRPR1(6)=$S($P(RMPRZERO,"^",13)=11:"I",1:"P")
 ;
SENDDATA ; Send charge data
 S RMPRCHRG=$$CHARGE^IBBAPI(RMPRDFN,RMPRARFN,RMPRTYPE,RMPRUCID,.RMPRFT1,.RMPRPR1,"","","","","")
 Q
 ;
SETAPD ; Set the APD cross-reference because the activity was only an edit, not a delete.
 S DIE="^RMPR(660,"
 S DA=RMPRIEN
 S DR="107///^S X=1"
 D ^DIE
 K DIE,DA,DR
 Q
EXIT ; Common exit point
 K ^TMP("RMPRPF3",RMPRIEN)
 K RMPRQTY,RMPRTC,RMPRCHRG,RMPRUCID,RMPRDFN,RMRICPP,RMPRCPT
 K RMPRARFN,RMPRTYPE,RMPRFT1,RMPRPR1,RMPRCPT,RMPRRICP
 K RMPRDG1,RMPRDIAG,RMPRZCL,RMPRNODE,RMPRPROS,RMPRHCPC,RMPRHCDT,RMPRVHC,RMPRTHC
 K ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU,ZTPRI,ZTSAVE,ZTKIL,ZTSYNC
 Q