Routine: RMPRPF3

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

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

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,"","","","","")

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

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPF3   2850     printed  Feb 19, 2025@00:02:20                                                                                                                                                                                                     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

RMPRPF3.m