79 lines
2.7 KiB
Mathematica
79 lines
2.7 KiB
Mathematica
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
|