APSQBRES ;IHS/ASDS/ENM/POC/PLS - PROCESS RESULTS OF POINT OF SALE CALL;09-Oct-2008 11:27;SM
;;7.0;IHS PHARMACY MODIFICATIONS;**1001,1007**;Sep 23, 2004
;---------------------------------------------------
S X=$$EN^APSQBRES(RXIEN,RFIEN,ADDDEL)
Q
; Returns POS call status
; Input: RXIEN - IEN to File 52
; RFIEN - IEN to Refill Multiple in File 52 - optional
; ADDDEL - Either an 'A'dd or 'D'elete flag
; REASON - Reason for claim reversal (OPTIONAL) - Added IHS/MSC/PLS - 08/21/08
EN(RXIEN,RFIEN,ADDDEL,REASON) ;EP
;Called by APSPFUNC and APSPRESK
N PSORES,PSOREST,DA,DR,DIE,X,Y,D0,DO,DD,MORE
Q:$$TEST("ABSPOSRX") ""
; Must have a prescription IEN
S:$L($G(REASON)) MORE("RXREASON")=REASON
I '+$G(RXIEN) S PSOREST="ERROR" G FIN
K:$G(RFIEN)="" RFIEN
I ADDDEL="A" D
.I $G(RFIEN)']"" S PSORES=$$CLAIM^ABSPOSRX(RXIEN)
.E S PSORES=$$CLAIM^ABSPOSRX(RXIEN,$G(RFIEN))
.S PSOREST=$$TEXTADD($G(PSORES))
.I +$G(RFIEN) S DA=RFIEN,DA(1)=RXIEN,DIE="^PSRX("_DA(1)_",1,",DR="9999999.08///^S X=PSOREST" D ^DIE
.I '+$G(RFIEN) S DA=RXIEN,DR="9999999.08///^S X=PSOREST",DIE="^PSRX(" D ^DIE
I ADDDEL="D" D
.S PSORES=$$UNCLAIM^ABSPOSRX(RXIEN,+$G(RFIEN),.MORE)
.S PSOREST=$$TEXTDEL($G(PSORES))
.I '+$G(RFIEN) S DA=RXIEN,DR="9999999.08///^S X=PSOREST",DIE="^PSRX(" D ^DIE
FIN Q PSOREST
;
STATUS(RXIEN,RFIEN) ;EP
Q:$$TEST("ABSPOSRX") ""
I '$G(RXIEN) Q ""
; Check for refill
I $G(RFIEN)]"" Q $$STATUS^ABSPOSRX(RXIEN,RFIEN)
; Default to prescription
Q $$STATUS^ABSPOSRX(RXIEN)
;
; Return Insurance Pointer
; Input: APSQIEN - IEN to ABSP NCPDP OVERRIDE (9002313.511)
; APSQDIEN - IEN to ABSP DUR/PSS (9002313.473)
OVERRIDE(APSQIEN,APSQDIEN) ;EP
;
;****** NOTE - CALLING ROUTINE SHOULD 'NEW' APSQDUR !!!!!
;****** (or kill it) - DON'T LEAVE THIS FIELD
;****** It is only done this way because of limitations
;****** experienced in PSORXED (can't handle multiple
;****** values coming back)
Q:$$TEST("ABSPOSO") ""
N (RFD,APSQIEN,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,ILST,IOT,IOXY,U,DT,DTIME,APSQCOM,APSQCOMR,APSQDIEN,APSQDUR)
S APSQDUR="" ;pre set to null
S APSQNIEN=$$NEWOVER^ABSPOSO($G(APSQIEN),$G(APSQDIEN))
S APSQDUR=$P(APSQNIEN,U,2) ;this is the DUR IEN
S APSQNIEN=$P(APSQNIEN,U) ;Pass back the insurance pointer
;
; If RFD is defined, a prescription is being edited.
I $D(RFD) D
.;For guarantee capture of this information, printing and calling bill program.
.S:'RFD APSQCOM="INSURER INFO ADDED/EDITED,"
.;For guarantee capture of this information, printing and call billing probram.
.S:RFD APSQCOMR="REFILL INSURER INFO ADDED/EDITED,"
Q APSQNIEN
TEST(X) ;EP
N QUIT
S QUIT='+$$GET1^DIQ(9009033,$G(PSOSITE),307,"I")
X:'QUIT ^%ZOSF("TEST") I '$T S QUIT=1
Q QUIT
; Return text for Add Status
; Input: Add Status Value
TEXTADD(STATUS) ; EP
N RES
I STATUS=1 S RES="WILL PROCESS"
E I STATUS=2 S RES="WILL PROCESS BUT HAS BEEN SUBMITTED PREVIOUSLY"
E I STATUS=3 S RES="PREVIOUS PAPER CLAIM, REVERSE AND RESUBMIT"
E I STATUS=4 S RES="PREVIOUS ELECTRONIC CLAIM, REVERSE AND RESUBMIT"
E I STATUS=-1 S RES="ALREADY CLAIM IN PROGRESS"
E I STATUS<0 S RES="FAILURE"
E S RES="UNKNOWN CLAIM STATUS"
Q RES
; Return text for Delete Status
; Input: Delete Status Value
TEXTDEL(STATUS) ; EP
N RES
I STATUS=1 S RES="WILL RESUBMIT FOR REVERSAL"
E I STATUS=-1 S RES="ALREADY TRANSACTION IN PROGRESS"
E I STATUS=-2 S RES="NO RECORD OF PREVIOUS CLAIM TO REVERSE"
E I STATUS=-3 S RES="NOT REVERSIBLE, MUST BE PAPER OR E PAYABLE"
E S RES="UNKNOWN REVERSAL STATUS"
Q RES
APSQBRES ;IHS/ASDS/ENM/POC/PLS - PROCESS RESULTS OF POINT OF SALE CALL;09-Oct-2008 11:27;SM
+1 ;;7.0;IHS PHARMACY MODIFICATIONS;**1001,1007**;Sep 23, 2004
+2 ;---------------------------------------------------
+3 SET X=$$EN^APSQBRES(RXIEN,RFIEN,ADDDEL)
+4 QUIT
+5 ; Returns POS call status
+6 ; Input: RXIEN - IEN to File 52
+7 ; RFIEN - IEN to Refill Multiple in File 52 - optional
+8 ; ADDDEL - Either an 'A'dd or 'D'elete flag
+9 ; REASON - Reason for claim reversal (OPTIONAL) - Added IHS/MSC/PLS - 08/21/08
EN(RXIEN,RFIEN,ADDDEL,REASON) ;EP
+1 ;Called by APSPFUNC and APSPRESK
+2 NEW PSORES,PSOREST,DA,DR,DIE,X,Y,D0,DO,DD,MORE
+3 IF $$TEST("ABSPOSRX")
QUIT ""
+4 ; Must have a prescription IEN
+5 IF $LENGTH($GET(REASON))
SET MORE("RXREASON")=REASON
+6 IF '+$GET(RXIEN)
SET PSOREST="ERROR"
GOTO FIN
+7 IF $GET(RFIEN)=""
KILL RFIEN
+8 IF ADDDEL="A"
Begin DoDot:1
+9 IF $GET(RFIEN)']""
SET PSORES=$$CLAIM^ABSPOSRX(RXIEN)
+10 IF '$TEST
SET PSORES=$$CLAIM^ABSPOSRX(RXIEN,$GET(RFIEN))
+11 SET PSOREST=$$TEXTADD($GET(PSORES))
+12 IF +$GET(RFIEN)
SET DA=RFIEN
SET DA(1)=RXIEN
SET DIE="^PSRX("_DA(1)_",1,"
SET DR="9999999.08///^S X=PSOREST"
DO ^DIE
+13 IF '+$GET(RFIEN)
SET DA=RXIEN
SET DR="9999999.08///^S X=PSOREST"
SET DIE="^PSRX("
DO ^DIE
End DoDot:1
+14 IF ADDDEL="D"
Begin DoDot:1
+15 SET PSORES=$$UNCLAIM^ABSPOSRX(RXIEN,+$GET(RFIEN),.MORE)
+16 SET PSOREST=$$TEXTDEL($GET(PSORES))
+17 IF '+$GET(RFIEN)
SET DA=RXIEN
SET DR="9999999.08///^S X=PSOREST"
SET DIE="^PSRX("
DO ^DIE
End DoDot:1
FIN QUIT PSOREST
+1 ;
STATUS(RXIEN,RFIEN) ;EP
+1 IF $$TEST("ABSPOSRX")
QUIT ""
+2 IF '$GET(RXIEN)
QUIT ""
+3 ; Check for refill
+4 IF $GET(RFIEN)]""
QUIT $$STATUS^ABSPOSRX(RXIEN,RFIEN)
+5 ; Default to prescription
+6 QUIT $$STATUS^ABSPOSRX(RXIEN)
+7 ;
+8 ; Return Insurance Pointer
+9 ; Input: APSQIEN - IEN to ABSP NCPDP OVERRIDE (9002313.511)
+10 ; APSQDIEN - IEN to ABSP DUR/PSS (9002313.473)
OVERRIDE(APSQIEN,APSQDIEN) ;EP
+1 ;
+2 ;****** NOTE - CALLING ROUTINE SHOULD 'NEW' APSQDUR !!!!!
+3 ;****** (or kill it) - DON'T LEAVE THIS FIELD
+4 ;****** It is only done this way because of limitations
+5 ;****** experienced in PSORXED (can't handle multiple
+6 ;****** values coming back)
+7 IF $$TEST("ABSPOSO")
QUIT ""
+8 NEW (RFD,APSQIEN,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,ILST,IOT,IOXY,U,DT,DTIME,APSQCOM,APSQCOMR,APSQDIEN,APSQDUR)
+9 ;pre set to null
SET APSQDUR=""
+10 SET APSQNIEN=$$NEWOVER^ABSPOSO($GET(APSQIEN),$GET(APSQDIEN))
+11 ;this is the DUR IEN
SET APSQDUR=$PIECE(APSQNIEN,U,2)
+12 ;Pass back the insurance pointer
SET APSQNIEN=$PIECE(APSQNIEN,U)
+13 ;
+14 ; If RFD is defined, a prescription is being edited.
+15 IF $DATA(RFD)
Begin DoDot:1
+16 ;For guarantee capture of this information, printing and calling bill program.
+17 IF 'RFD
SET APSQCOM="INSURER INFO ADDED/EDITED,"
+18 ;For guarantee capture of this information, printing and call billing probram.
+19 IF RFD
SET APSQCOMR="REFILL INSURER INFO ADDED/EDITED,"
End DoDot:1
+20 QUIT APSQNIEN
TEST(X) ;EP
+1 NEW QUIT
+2 SET QUIT='+$$GET1^DIQ(9009033,$GET(PSOSITE),307,"I")
+3 IF 'QUIT
XECUTE ^%ZOSF("TEST")
IF '$TEST
SET QUIT=1
+4 QUIT QUIT
+5 ; Return text for Add Status
+6 ; Input: Add Status Value
TEXTADD(STATUS) ; EP
+1 NEW RES
+2 IF STATUS=1
SET RES="WILL PROCESS"
+3 IF '$TEST
IF STATUS=2
SET RES="WILL PROCESS BUT HAS BEEN SUBMITTED PREVIOUSLY"
+4 IF '$TEST
IF STATUS=3
SET RES="PREVIOUS PAPER CLAIM, REVERSE AND RESUBMIT"
+5 IF '$TEST
IF STATUS=4
SET RES="PREVIOUS ELECTRONIC CLAIM, REVERSE AND RESUBMIT"
+6 IF '$TEST
IF STATUS=-1
SET RES="ALREADY CLAIM IN PROGRESS"
+7 IF '$TEST
IF STATUS<0
SET RES="FAILURE"
+8 IF '$TEST
SET RES="UNKNOWN CLAIM STATUS"
+9 QUIT RES
+10 ; Return text for Delete Status
+11 ; Input: Delete Status Value
TEXTDEL(STATUS) ; EP
+1 NEW RES
+2 IF STATUS=1
SET RES="WILL RESUBMIT FOR REVERSAL"
+3 IF '$TEST
IF STATUS=-1
SET RES="ALREADY TRANSACTION IN PROGRESS"
+4 IF '$TEST
IF STATUS=-2
SET RES="NO RECORD OF PREVIOUS CLAIM TO REVERSE"
+5 IF '$TEST
IF STATUS=-3
SET RES="NOT REVERSIBLE, MUST BE PAPER OR E PAYABLE"
+6 IF '$TEST
SET RES="UNKNOWN REVERSAL STATUS"
+7 QUIT RES
