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