| [613] | 1 | RMPRPF3 ;HOIFO/TH,DDA - PFSS Charge Cancel (credit) ;8/18/05
|
|---|
| 2 | ;;3.0;PROSTHETICS;**98**;Feb 09, 1996
|
|---|
| 3 | ;
|
|---|
| 4 | ; This routine sends "Credit" Charge Message to IBB if .01 field got deleted in file 660
|
|---|
| 5 | ; or if the PSAS HCPCS code is deleted (equals null after user edit).
|
|---|
| 6 | ;
|
|---|
| 7 | ; DBIA # 4663 for SWSTAT^IBBAPI
|
|---|
| 8 | ; DBIA # 4665 for CHARGE^IBBAPI
|
|---|
| 9 | Q
|
|---|
| 10 | ;
|
|---|
| 11 | CHRGTASK ; FILE #660, ENTRY DATE AND PSAS HCPCS FIELDS MUMPS XREF
|
|---|
| 12 | ;KILL LOGIC.
|
|---|
| 13 | ; TASKMAN LOAD A ONE TIME TASKMAN TASK.
|
|---|
| 14 | ; QUIT IF PFSS SWITCH IS OFF OR IF THERE IS NO CHARGE TO REVERSE
|
|---|
| 15 | Q:'+$$SWSTAT^IBBAPI()
|
|---|
| 16 | S RMPRPFSS=$G(^RMPR(660,DA,"PFSS"))
|
|---|
| 17 | Q:$P(RMPRPFSS,"^",2)=""
|
|---|
| 18 | S RMPRZERO=^RMPR(660,DA,0)
|
|---|
| 19 | N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU,ZTPRI,ZTSAVE,ZTKIL,ZTSYNC
|
|---|
| 20 | S ZTIO="",ZTRTN="CHRGCRED^RMPRPF3",ZTDESC="Prosthetics file #660 PFSS Charge Credit",ZTDTH=$H
|
|---|
| 21 | S ZTSAVE("RMPRIEN")=DA
|
|---|
| 22 | S ZTSAVE("RMPRZERO")=RMPRZERO
|
|---|
| 23 | S ZTSAVE("RMPRONE")=$G(^RMPR(660,DA,1))
|
|---|
| 24 | S ZTSAVE("RMPRTEN")=$G(^RMPR(660,DA,10))
|
|---|
| 25 | S ZTSAVE("RMPRPFSS")=RMPRPFSS
|
|---|
| 26 | D ^%ZTLOAD
|
|---|
| 27 | Q
|
|---|
| 28 | ;
|
|---|
| 29 | CHRGCRED ; Process account deletion/cancellation
|
|---|
| 30 | ;
|
|---|
| 31 | ; Check if already processing this record.
|
|---|
| 32 | Q:$G(^TMP("RMPRPF3",RMPRIEN))=RMPRIEN
|
|---|
| 33 | S ^TMP("RMPRPF3",RMPRIEN)=RMPRIEN
|
|---|
| 34 | ; Check if this is just a Date edit or a PSAS HCPCS edit, set x-ref AND QUIT.
|
|---|
| 35 | S RMPRCDFL=0
|
|---|
| 36 | S:'$D(^RMPR(660,RMPRIEN,0)) RMPRCDFL=1
|
|---|
| 37 | S:$P($G(RMPRONE),"^",4)="" RMPRCDFL=1
|
|---|
| 38 | I RMPRCDFL=0 D SETAPD G EXIT
|
|---|
| 39 | ; RECORD HAS EITHER BEEN DELETED OR PSAS HCPCS HAS BEEN DELETED. SEND A CREDIT (CD).
|
|---|
| 40 | S RMPRUCID=$P(RMPRPFSS,U,2)
|
|---|
| 41 | S RMPRTYPE="CD"
|
|---|
| 42 | S RMPRDFN=$P(RMPRZERO,"^",2)
|
|---|
| 43 | S RMPRARFN=$P(RMPRPFSS,"^")
|
|---|
| 44 | ;
|
|---|
| 45 | ; FT1
|
|---|
| 46 | S RMPRFT1(4)=$P(RMPRZERO,"^",12) ; Delivery Date
|
|---|
| 47 | S RMPRFT1(10)=$P(RMPRZERO,"^",7) ; Transaction Quantity
|
|---|
| 48 | S RMPRFT1(13)=423 ; Department Code
|
|---|
| 49 | S RMPRFT1(21)=$P($G(RMPRTEN),"^",6) ; Ordering Provider/Ordered by Code
|
|---|
| 50 | S RMPRTC=$P(RMPRZERO,"^",16)
|
|---|
| 51 | S RMPRFT1(22)=RMPRTC/RMPRFT1(10) ; Unit Cost = Total Cost/QTY
|
|---|
| 52 | ; PR1
|
|---|
| 53 | S RMPRHCPC=$P(RMPRONE,"^",4)
|
|---|
| 54 | S RMPRHCDT=$P(RMPRONE,"^")
|
|---|
| 55 | D PSASHCPC^RMPOPF
|
|---|
| 56 | S RMPRPR1(3)=RMPRVHC ; Procedure Code
|
|---|
| 57 | S RMPRPR1(4)=RMPRTHC ; PSAS HCPCS text
|
|---|
| 58 | ; Procedure Functional Type - I:Stock Issue;P:Purchasing
|
|---|
| 59 | S RMPRPR1(6)=$S($P(RMPRZERO,"^",13)=11:"I",1:"P")
|
|---|
| 60 | ;
|
|---|
| 61 | SENDDATA ; Send charge data
|
|---|
| 62 | S RMPRCHRG=$$CHARGE^IBBAPI(RMPRDFN,RMPRARFN,RMPRTYPE,RMPRUCID,.RMPRFT1,.RMPRPR1,"","","","","")
|
|---|
| 63 | Q
|
|---|
| 64 | ;
|
|---|
| 65 | SETAPD ; Set the APD cross-reference because the activity was only an edit, not a delete.
|
|---|
| 66 | S DIE="^RMPR(660,"
|
|---|
| 67 | S DA=RMPRIEN
|
|---|
| 68 | S DR="107///^S X=1"
|
|---|
| 69 | D ^DIE
|
|---|
| 70 | K DIE,DA,DR
|
|---|
| 71 | Q
|
|---|
| 72 | EXIT ; Common exit point
|
|---|
| 73 | K ^TMP("RMPRPF3",RMPRIEN)
|
|---|
| 74 | K RMPRQTY,RMPRTC,RMPRCHRG,RMPRUCID,RMPRDFN,RMRICPP,RMPRCPT
|
|---|
| 75 | K RMPRARFN,RMPRTYPE,RMPRFT1,RMPRPR1,RMPRCPT,RMPRRICP
|
|---|
| 76 | K RMPRDG1,RMPRDIAG,RMPRZCL,RMPRNODE,RMPRPROS,RMPRHCPC,RMPRHCDT,RMPRVHC,RMPRTHC
|
|---|
| 77 | K ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU,ZTPRI,ZTSAVE,ZTKIL,ZTSYNC
|
|---|
| 78 | Q
|
|---|
