APSQBRES.m

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