ABSPOS6B.m

ABSPOS6B ; IHS/FCS/DRS - user display screen, cont ;  

 ;;1.0;PHARMACY POINT OF SALE;*29,31*;JUN 21, 2001;Build 38

 Q

INFO(PAT,RXI)         ;EP - from ABSPOS6H

 ; IF '$G(RXI), then this is a patient summary line:

 ;   INFO("%")=% completion

 ;   INFO("COUNT")=how many for this patient

 ;   INFO("PATIEN")=ien into patient file

 ;   INFO("STAT",status)=count

 ;   INFO("RES")="- - - 3 prescriptions - - -", for example, if inc.

 ;   but if complete,

 ;   INFO("RES")="* FINISHED * 1 rejected * 2 payable", for example

 ;

 ; If we are going to do prescription detail, then the RESULTS

 ; area for this patient will simply say how many prescriptions

 ; and each individual prescription has its own result detail

 ; But if this is a patient summary with no prescription detail,

 ; then pull all the results together into:

 ; INFO("RES",result code^text)=count

 ;

 ; IF $G(RXI), then this is a prescription detail line

 ;  INFO("DRUG")=drug name

 ;  INFO("RES")=final result or processing status, and presc. #

 ;           (depending on whether status is 100% or not)

 ;  INFO("PATIEN") as above

 ;  INFO("STAT")=processing status (text)

 ;  INFO("DUR")=Brief DUR response info (just conflict and message)

 ;

INFO1 IF $G(RXI) D  Q

 .N REVERSAL S REVERSAL=$G(^ABSPT(RXI,4)) ; is it a rev'l?

 .I 'REVERSAL S REVERSAL=$P(REVERSAL,U,3) ; if not elect, maybe paper

 .N INSURER S INSURER=$P(^ABSPT(RXI,1),U,6)

 .S INSURER=$S(INSURER:$P(^AUTNINS(INSURER,0),U),1:"")

 .; eligibility etc. for SELF PAY reworded during final result

 .; in ABSPOSQ1 and then again for real in billing

 .N IEN52 S IEN52=$P(^ABSPT(RXI,1),U,11)

 .N X

 .I IEN52 D

 . . N RX0 S RX0=$G(^PSRX(IEN52,0)),X=$P(RX0,U,6)

 . . I X]"" S X=$P($G(^PSDRUG(X,0)),U)

 . . I X="" S X="(can't find in DRUG file?)"

 . . I RXI[".",$E(RXI,$L(RXI))=2 S X="Postage-"_X

 .E  D

 . . N CPT S CPT=$P(RXI,".",2),CPT=+$E(CPT,1,$L(CPT)-1)

 . . ; $GET because of timing problem?

 . . S X=$P($G(^ABSCPT(9002300,CPT,0)),U,2) ; short desc

 .S INFO("DRUG")=X,INFO("STAT")=""

 .;I ONEPAT S INFO("STAT")=$$ONEPAT^ABSPOS6C_" " ; dates

 .;I REVERSAL S INFO("STAT")=INFO("STAT")_"*REVERSAL* "

 .S INFO("RES")=INFO("STAT")

 .N STAT S STAT=$P(@DISP@(PAT,RXI),U,2)

 .I STAT=100 D

 . . S INFO("DUR")=$$DURBRIEF^ABSPOS6G(RXI)

 . . I INFO("DUR")]"" S INFO("RES")=INFO("RES")_"DUR! "

 .E  D

 . . S INFO("DUR")=""

 . . S INFO("STAT")=INFO("STAT")_$$STATI^ABSPOSU(STAT)

 .I STAT=31!(STAT=51) D  ; retry due to comms problem or ins. asleep

 . . N X S X=$G(^ABSPT(RXI,8)) Q:X=""

 . . N Y S Y=$P(X,U) X ^DD("DD") S Y=$P(Y,"@",2),X=$P(X,U,2)

 . . S INFO("STAT")=INFO("STAT")_" after "_Y

 . . Q:'X  S X=$P(^ABSP(9002313.55,X,0),U)

 . . I STAT=51 S INFO("STAT")=INFO("STAT")_" to dial out to "_X

 .I INSURER]"" D

 . . N X S X=INFO("STAT")_" "

 . . S X=X_$S(STAT>99:"by",STAT>69:"from",STAT>49:"to",1:"for")

 . . S INFO("STAT")=X_" "_INSURER

 .I STAT=100 D

 . . N X S X=$$RESULT(RXI)

 . . S INFO("RES")=$S(X]"":X,1:"(Missing result?)")

 . E  S INFO("RES")=INFO("STAT")

 .S INFO("RES")=INFO("RES")_" ("_$S(RXI[".":RXI,1:"Prescription `"_RXI)_")"

 .S INFO("PATIEN")=$P(^ABSPT(RXI,0),U,6)

 .I 'INFO("PATIEN") S INFO("PATIEN")=$P($G(^PSRX(IEN52,0)),U,2)

 .I INFO("DUR")]"" S INFO("RES")=INFO("RES")_" DUR:"_INFO("DUR")

 .I REVERSAL S INFO("RES")="*REVERSAL* "_INFO("RES")

 .I ONEPAT S INFO("RES")=$$ONEPAT^ABSPOS6C_" "_INFO("RES")

 .I STAT<99,$G(^ABSPT(RXI,3)) D

 ..S INFO("RES")="*CANCELLATION REQUESTED* "_INFO("RES")

 ;

 ; Else we're doing a patient record:

 ;

INFO6 N X S X=@DISP@(PAT)

 N N,K S (N,INFO("COUNT"))=$P(X,U,4)

 S INFO("%")=$P(X,U,2)/$P(X,U,4)+.5\1

 I INFO("%")=100 D

 .S INFO("RES")="** FINISHED ** "

 .I $P(X,U,5)+$P(X,U,6)+$P(X,U,7)+$P(X,U,8)+$P(X,U,9)'=N D INFO8 ;reCALC

 .S K=$P(X,U,5) I K D  S INFO("RES")=INFO("RES")_K_" rejected  *"

 ..S K=$S(N=1:"",K=N:$S(K=2:"BOTH",1:"ALL"),1:K)

 .S K=$P(X,U,6) I K D  S INFO("RES")=INFO("RES")_K_" not electronic  *"

 ..S K=$S(N=1:"",K=N:$S(K=2:"BOTH",1:"ALL"),1:K)

 .S K=$P(X,U,7) I K D  S INFO("RES")=INFO("RES")_K_" payable  *"

 ..S K=$S(N=1:"",K=N:$S(K=2:"BOTH",1:"ALL"),1:K)

 .S K=$P(X,U,8) I K D  S INFO("RES")=INFO("RES")_K_" rejected reversal *"

 ..S K=$S(N=1:"",K=N:$S(K=2:"BOTH",1:"ALL"),1:K)

 .S K=$P(X,U,9) I K D  S INFO("RES")=INFO("RES")_K_" accepted reversal *"

 ..S K=$S(N=1:"",K=N:$S(K=2:"BOTH",1:"ALL"),1:K)

 .S INFO("RES")=INFO("RES")_"*"

 E  D

 .N N,S ;,C

 .S N=$P(X,U,4),S=$S(N=1:"",1:"s") ;,C=$P(X,U,5)+$P(X,U,6)+$P(X,U,7)

 .S INFO("RES")="     - - - "_N_" prescription"_S_" - - -"

 ; Set DODETAIL=1 if we are doing prescription detail, 0 if not

 N DODETAIL S DODETAIL=1  ;(INFO("COUNT")'<^TMP("ABSPOS",$J,"DETAIL"))

 N RXI,I S RXI="" F I=1:1:INFO("COUNT") D

 .S RXI=$O(@DISP@(PAT,RXI))

 .N IEN52 S IEN52=$P(^ABSPT(RXI,1),U,11)

 .I I=1 D

 . . S INFO("PATIEN")=$P(^ABSPT(RXI,0),U,6)

 . . ;S INFO("PATIEN")=$P($G(^PSRX(IEN52,0)),U,2)

 .I 'DODETAIL D  ; if not doing line item detail, summarize it

 ..S X=$$RESULT(RXI)

 ..I X]"" S INFO("RES",X)=$G(INFO("RES",X))+1

 ..N STAT S STAT=$P(@DISP@(PAT,RXI),U,2),INFO("STAT",STAT)=$G(INFO("STAT",STAT))+1

 Q

INFO8 ; retally the counts of rejected, not electronic, payable

 ; This could be necessary if a prescription was rejected, then

 ; resubmitted with corrections, and then paid - it would have been

 ; counted in two different buckets.

 ; Given X = the current value of @DISP@(PAT)

 ; Fix X and also store the fixed-up version in @DISP@(PAT,RXI)

 S $P(X,U,5,9)="0^0^0^0^0" ; reset the counts

 N RXI S RXI="" F  S RXI=$O(@DISP@(PAT,RXI)) Q:RXI=""  D INFO9

 S @DISP@(PAT)=X

 Q

INFO9 ; Given X, PAT, RXI, @DISP@(PAT,RXI)

 N B S B=$$BUCKET(RXI)

 S $P(X,U,B)=$P(X,U,B)+1

 Q

BUCKET(RXI)        ;EP - from ABSPOS6I

 ; for ^TMP("ABSPOS",$J,"DISP") pieces

 N R S R=$E($$RSPTYP(RXI))

 N V S V=$G(^ABSPT(RXI,4))

 I R="P" Q 7

 I R="" Q 6

 I R="R" Q $S(V:8,1:5)

 I R="A" Q 9

 Q 6  ; NEED A VALID BUCKET, EVEN IF THIS IS THE WRONG ONE

 ; 5 if rejected claim

 ; 6 if other failure

 ; 7 if paid

 ; 8 if rejected reversal

 ; 9 if accepted reversal

RESULT(RXI)        ;EP - from ABSPOSIV

 N REC,RES,M S M=240 S REC(2)=$G(^ABSPT(RXI,2))

 I REC(2)="" Q ""

 N RES S RES=$P(REC(2),U),REC(2)=$P(REC(2),U,2,$L(REC(2),U))

 I RES=1 Q REC(2)

 I RES'=0 Q REC(2)_" (code "_RES_")"

 ; RES=0, good, we can go to the claim response and see what it says

 N RSP D RESPINFO^ABSPOSQ4(RXI,.RSP)

 ; Rework this - 10/28/2000 - because Oklahoma Medicaid seems to 

 ; make Packet Header Rejected, even though the Header is acceptable.

 ; But apparently if all the prescriptions are rejected, they give

 ; you a rejected packet header.  Or maybe if it's a patient-level

 ; problem, they do that.  Anyhow, the change made today is to always

 ; print individual prescription rejection reasons and to push the 

 ; "PACKET HEADER REJECTED" message to the end.

 D  ; 

 .;S RES=RSP("RSP") ; prescription response status

 .S RES=$G(RSP("RSP")) ; prescription response status IHS/OIT/SCR patch 29

 .I RES="Rejected" D

 ..S RES=RES_"("

 ..N I F I=1:1:RSP("REJ",0) D

 ...I I'=1 S RES=RES_","

 ...S RES=RES_RSP("REJ",I)

 ...I $L(RES)>M S RES=$E(RES,1,M)

 ..S RES=RES_")"

 ;I RSP("MSG")]"" S RES=RES_"; "_RSP("MSG") ; and any extra message

 I $G(RSP("MSG"))]"" S RES=RES_"; "_RSP("MSG") ; and any extra message

 ;I RSP("HDR")'="Accepted" D  ;packet header not accepted

 I $G(RSP("HDR"))'="Accepted" D  ;packet header not accepted

 .;I RSP("HDR")="" S RSP("HDR")="?status null?"

 .I $G(RSP("HDR"))="" S RSP("HDR")="?status null?"  ;IHS/OIT/SCR 05/15/09 patch 31

 .S RES=RES_";PACKET HEADER "_RSP("HDR")

 Q $E(RES,1,M)

RSPTYP(RXI)        ; quicker version of RESULT

 ; returns P payable, R rejected, or C or D, or "" if no resp packet

 N RSP D RESPINFO^ABSPOSQ4(RXI,.RSP)

 Q $G(RSP("RSP"))

 ;

ABSPOS6B  ; IHS/FCS/DRS - user display screen, cont ;  

 +1       ;;1.0;PHARMACY POINT OF SALE;*29,31*;JUN 21, 2001;Build 38

 +2        QUIT 

INFO(PAT,RXI) ;EP - from ABSPOS6H

 +1       ; IF '$G(RXI), then this is a patient summary line:

 +2       ;   INFO("%")=% completion

 +3       ;   INFO("COUNT")=how many for this patient

 +4       ;   INFO("PATIEN")=ien into patient file

 +5       ;   INFO("STAT",status)=count

 +6       ;   INFO("RES")="- - - 3 prescriptions - - -", for example, if inc.

 +7       ;   but if complete,

 +8       ;   INFO("RES")="* FINISHED * 1 rejected * 2 payable", for example

 +9       ;

 +10      ; If we are going to do prescription detail, then the RESULTS

 +11      ; area for this patient will simply say how many prescriptions

 +12      ; and each individual prescription has its own result detail

 +13      ; But if this is a patient summary with no prescription detail,

 +14      ; then pull all the results together into:

 +15      ; INFO("RES",result code^text)=count

 +16      ;

 +17      ; IF $G(RXI), then this is a prescription detail line

 +18      ;  INFO("DRUG")=drug name

 +19      ;  INFO("RES")=final result or processing status, and presc. #

 +20      ;           (depending on whether status is 100% or not)

 +21      ;  INFO("PATIEN") as above

 +22      ;  INFO("STAT")=processing status (text)

 +23      ;  INFO("DUR")=Brief DUR response info (just conflict and message)

 +24      ;

INFO1      IF $GET(RXI)

               Begin DoDot:1

 +1       ; is it a rev'l?

                   NEW REVERSAL

                   SET REVERSAL=$GET(^ABSPT(RXI,4))

 +2       ; if not elect, maybe paper

                   IF 'REVERSAL

                       SET REVERSAL=$PIECE(REVERSAL,U,3)

 +3                NEW INSURER

                   SET INSURER=$PIECE(^ABSPT(RXI,1),U,6)

 +4                SET INSURER=$SELECT(INSURER:$PIECE(^AUTNINS(INSURER,0),U),1:"")

 +5       ; eligibility etc. for SELF PAY reworded during final result

 +6       ; in ABSPOSQ1 and then again for real in billing

 +7                NEW IEN52

                   SET IEN52=$PIECE(^ABSPT(RXI,1),U,11)

 +8                NEW X

 +9                IF IEN52

                       Begin DoDot:2

 +10                       NEW RX0

                           SET RX0=$GET(^PSRX(IEN52,0))

                           SET X=$PIECE(RX0,U,6)

 +11                       IF X]""

                               SET X=$PIECE($GET(^PSDRUG(X,0)),U)

 +12                       IF X=""

                               SET X="(can't find in DRUG file?)"

 +13                       IF RXI["."

                               IF $EXTRACT(RXI,$LENGTH(RXI))=2

                                   SET X="Postage-"_X

                       End DoDot:2

 +14              IF '$TEST

                       Begin DoDot:2

 +15                       NEW CPT

                           SET CPT=$PIECE(RXI,".",2)

                           SET CPT=+$EXTRACT(CPT,1,$LENGTH(CPT)-1)

 +16      ; $GET because of timing problem?

 +17      ; short desc

                           SET X=$PIECE($GET(^ABSCPT(9002300,CPT,0)),U,2)

                       End DoDot:2

 +18               SET INFO("DRUG")=X

                   SET INFO("STAT")=""

 +19      ;I ONEPAT S INFO("STAT")=$$ONEPAT^ABSPOS6C_" " ; dates

 +20      ;I REVERSAL S INFO("STAT")=INFO("STAT")_"*REVERSAL* "

 +21               SET INFO("RES")=INFO("STAT")

 +22               NEW STAT

                   SET STAT=$PIECE(@DISP@(PAT,RXI),U,2)

 +23               IF STAT=100

                       Begin DoDot:2

 +24                       SET INFO("DUR")=$$DURBRIEF^ABSPOS6G(RXI)

 +25                       IF INFO("DUR")]""

                               SET INFO("RES")=INFO("RES")_"DUR! "

                       End DoDot:2

 +26              IF '$TEST

                       Begin DoDot:2

 +27                       SET INFO("DUR")=""

 +28                       SET INFO("STAT")=INFO("STAT")_$$STATI^ABSPOSU(STAT)

                       End DoDot:2

 +29      ; retry due to comms problem or ins. asleep

                   IF STAT=31!(STAT=51)

                       Begin DoDot:2

 +30                       NEW X

                           SET X=$GET(^ABSPT(RXI,8))

                           IF X=""

                               QUIT 

 +31                       NEW Y

                           SET Y=$PIECE(X,U)

                           XECUTE ^DD("DD")

                           SET Y=$PIECE(Y,"@",2)

                           SET X=$PIECE(X,U,2)

 +32                       SET INFO("STAT")=INFO("STAT")_" after "_Y

 +33                       IF 'X

                               QUIT 

                           SET X=$PIECE(^ABSP(9002313.55,X,0),U)

 +34                       IF STAT=51

                               SET INFO("STAT")=INFO("STAT")_" to dial out to "_X

                       End DoDot:2

 +35               IF INSURER]""

                       Begin DoDot:2

 +36                       NEW X

                           SET X=INFO("STAT")_" "

 +37                       SET X=X_$SELECT(STAT>99:"by",STAT>69:"from",STAT>49:"to",1:"for")

 +38                       SET INFO("STAT")=X_" "_INSURER

                       End DoDot:2

 +39               IF STAT=100

                       Begin DoDot:2

 +40                       NEW X

                           SET X=$$RESULT(RXI)

 +41                       SET INFO("RES")=$SELECT(X]"":X,1:"(Missing result?)")

                       End DoDot:2

 +42              IF '$TEST

                       SET INFO("RES")=INFO("STAT")

 +43               SET INFO("RES")=INFO("RES")_" ("_$SELECT(RXI[".":RXI,1:"Prescription `"_RXI)_")"

 +44               SET INFO("PATIEN")=$PIECE(^ABSPT(RXI,0),U,6)

 +45               IF 'INFO("PATIEN")

                       SET INFO("PATIEN")=$PIECE($GET(^PSRX(IEN52,0)),U,2)

 +46               IF INFO("DUR")]""

                       SET INFO("RES")=INFO("RES")_" DUR:"_INFO("DUR")

 +47               IF REVERSAL

                       SET INFO("RES")="*REVERSAL* "_INFO("RES")

 +48               IF ONEPAT

                       SET INFO("RES")=$$ONEPAT^ABSPOS6C_" "_INFO("RES")

 +49               IF STAT<99

                       IF $GET(^ABSPT(RXI,3))

                           Begin DoDot:2

 +50                           SET INFO("RES")="*CANCELLATION REQUESTED* "_INFO("RES")

                           End DoDot:2

               End DoDot:1

               QUIT 

 +51      ;

 +52      ; Else we're doing a patient record:

 +53      ;

INFO6      NEW X

           SET X=@DISP@(PAT)

 +1        NEW N,K

           SET (N,INFO("COUNT"))=$PIECE(X,U,4)

 +2        SET INFO("%")=$PIECE(X,U,2)/$PIECE(X,U,4)+.5\1

 +3        IF INFO("%")=100

               Begin DoDot:1

 +4                SET INFO("RES")="** FINISHED ** "

 +5       ;reCALC

                   IF $PIECE(X,U,5)+$PIECE(X,U,6)+$PIECE(X,U,7)+$PIECE(X,U,8)+$PIECE(X,U,9)'=N

                       DO INFO8

 +6                SET K=$PIECE(X,U,5)

                   IF K

                       Begin DoDot:2

 +7                        SET K=$SELECT(N=1:"",K=N:$SELECT(K=2:"BOTH",1:"ALL"),1:K)

                       End DoDot:2

                       SET INFO("RES")=INFO("RES")_K_" rejected  *"

 +8                SET K=$PIECE(X,U,6)

                   IF K

                       Begin DoDot:2

 +9                        SET K=$SELECT(N=1:"",K=N:$SELECT(K=2:"BOTH",1:"ALL"),1:K)

                       End DoDot:2

                       SET INFO("RES")=INFO("RES")_K_" not electronic  *"

 +10               SET K=$PIECE(X,U,7)

                   IF K

                       Begin DoDot:2

 +11                       SET K=$SELECT(N=1:"",K=N:$SELECT(K=2:"BOTH",1:"ALL"),1:K)

                       End DoDot:2

                       SET INFO("RES")=INFO("RES")_K_" payable  *"

 +12               SET K=$PIECE(X,U,8)

                   IF K

                       Begin DoDot:2

 +13                       SET K=$SELECT(N=1:"",K=N:$SELECT(K=2:"BOTH",1:"ALL"),1:K)

                       End DoDot:2

                       SET INFO("RES")=INFO("RES")_K_" rejected reversal *"

 +14               SET K=$PIECE(X,U,9)

                   IF K

                       Begin DoDot:2

 +15                       SET K=$SELECT(N=1:"",K=N:$SELECT(K=2:"BOTH",1:"ALL"),1:K)

                       End DoDot:2

                       SET INFO("RES")=INFO("RES")_K_" accepted reversal *"

 +16               SET INFO("RES")=INFO("RES")_"*"

               End DoDot:1

 +17      IF '$TEST

               Begin DoDot:1

 +18      ;,C

                   NEW N,S

 +19      ;,C=$P(X,U,5)+$P(X,U,6)+$P(X,U,7)

                   SET N=$PIECE(X,U,4)

                   SET S=$SELECT(N=1:"",1:"s")

 +20               SET INFO("RES")="     - - - "_N_" prescription"_S_" - - -"

               End DoDot:1

 +21      ; Set DODETAIL=1 if we are doing prescription detail, 0 if not

 +22      ;(INFO("COUNT")'<^TMP("ABSPOS",$J,"DETAIL"))

           NEW DODETAIL

           SET DODETAIL=1

 +23       NEW RXI,I

           SET RXI=""

           FOR I=1:1:INFO("COUNT")

               Begin DoDot:1

 +24               SET RXI=$ORDER(@DISP@(PAT,RXI))

 +25               NEW IEN52

                   SET IEN52=$PIECE(^ABSPT(RXI,1),U,11)

 +26               IF I=1

                       Begin DoDot:2

 +27                       SET INFO("PATIEN")=$PIECE(^ABSPT(RXI,0),U,6)

 +28      ;S INFO("PATIEN")=$P($G(^PSRX(IEN52,0)),U,2)

                       End DoDot:2

 +29      ; if not doing line item detail, summarize it

                   IF 'DODETAIL

                       Begin DoDot:2

 +30                       SET X=$$RESULT(RXI)

 +31                       IF X]""

                               SET INFO("RES",X)=$GET(INFO("RES",X))+1

 +32                       NEW STAT

                           SET STAT=$PIECE(@DISP@(PAT,RXI),U,2)

                           SET INFO("STAT",STAT)=$GET(INFO("STAT",STAT))+1

                       End DoDot:2

               End DoDot:1

 +33       QUIT 

INFO8     ; retally the counts of rejected, not electronic, payable

 +1       ; This could be necessary if a prescription was rejected, then

 +2       ; resubmitted with corrections, and then paid - it would have been

 +3       ; counted in two different buckets.

 +4       ; Given X = the current value of @DISP@(PAT)

 +5       ; Fix X and also store the fixed-up version in @DISP@(PAT,RXI)

 +6       ; reset the counts

           SET $PIECE(X,U,5,9)="0^0^0^0^0"

 +7        NEW RXI

           SET RXI=""

           FOR 

               SET RXI=$ORDER(@DISP@(PAT,RXI))

               IF RXI=""

                   QUIT 

               DO INFO9

 +8        SET @DISP@(PAT)=X

 +9        QUIT 

INFO9     ; Given X, PAT, RXI, @DISP@(PAT,RXI)

 +1        NEW B

           SET B=$$BUCKET(RXI)

 +2        SET $PIECE(X,U,B)=$PIECE(X,U,B)+1

 +3        QUIT 

BUCKET(RXI) ;EP - from ABSPOS6I

 +1       ; for ^TMP("ABSPOS",$J,"DISP") pieces

 +2        NEW R

           SET R=$EXTRACT($$RSPTYP(RXI))

 +3        NEW V

           SET V=$GET(^ABSPT(RXI,4))

 +4        IF R="P"

               QUIT 7

 +5        IF R=""

               QUIT 6

 +6        IF R="R"

               QUIT $SELECT(V:8,1:5)

 +7        IF R="A"

               QUIT 9

 +8       ; NEED A VALID BUCKET, EVEN IF THIS IS THE WRONG ONE

           QUIT 6

 +9       ; 5 if rejected claim

 +10      ; 6 if other failure

 +11      ; 7 if paid

 +12      ; 8 if rejected reversal

 +13      ; 9 if accepted reversal

RESULT(RXI) ;EP - from ABSPOSIV

 +1        NEW REC,RES,M

           SET M=240

           SET REC(2)=$GET(^ABSPT(RXI,2))

 +2        IF REC(2)=""

               QUIT ""

 +3        NEW RES

           SET RES=$PIECE(REC(2),U)

           SET REC(2)=$PIECE(REC(2),U,2,$LENGTH(REC(2),U))

 +4        IF RES=1

               QUIT REC(2)

 +5        IF RES'=0

               QUIT REC(2)_" (code "_RES_")"

 +6       ; RES=0, good, we can go to the claim response and see what it says

 +7        NEW RSP

           DO RESPINFO^ABSPOSQ4(RXI,.RSP)

 +8       ; Rework this - 10/28/2000 - because Oklahoma Medicaid seems to 

 +9       ; make Packet Header Rejected, even though the Header is acceptable.

 +10      ; But apparently if all the prescriptions are rejected, they give

 +11      ; you a rejected packet header.  Or maybe if it's a patient-level

 +12      ; problem, they do that.  Anyhow, the change made today is to always

 +13      ; print individual prescription rejection reasons and to push the 

 +14      ; "PACKET HEADER REJECTED" message to the end.

 +15      ; 

           Begin DoDot:1

 +16      ;S RES=RSP("RSP") ; prescription response status

 +17      ; prescription response status IHS/OIT/SCR patch 29

               SET RES=$GET(RSP("RSP"))

 +18           IF RES="Rejected"

                   Begin DoDot:2

 +19                   SET RES=RES_"("

 +20                   NEW I

                       FOR I=1:1:RSP("REJ",0)

                           Begin DoDot:3

 +21                           IF I'=1

                                   SET RES=RES_","

 +22                           SET RES=RES_RSP("REJ",I)

 +23                           IF $LENGTH(RES)>M

                                   SET RES=$EXTRACT(RES,1,M)

                           End DoDot:3

 +24                   SET RES=RES_")"

                   End DoDot:2

           End DoDot:1

 +25      ;I RSP("MSG")]"" S RES=RES_"; "_RSP("MSG") ; and any extra message

 +26      ; and any extra message

           IF $GET(RSP("MSG"))]""

               SET RES=RES_"; "_RSP("MSG")

 +27      ;I RSP("HDR")'="Accepted" D  ;packet header not accepted

 +28      ;packet header not accepted

           IF $GET(RSP("HDR"))'="Accepted"

               Begin DoDot:1

 +29      ;I RSP("HDR")="" S RSP("HDR")="?status null?"

 +30      ;IHS/OIT/SCR 05/15/09 patch 31

                   IF $GET(RSP("HDR"))=""

                       SET RSP("HDR")="?status null?"

 +31               SET RES=RES_";PACKET HEADER "_RSP("HDR")

               End DoDot:1

 +32       QUIT $EXTRACT(RES,1,M)

RSPTYP(RXI) ; quicker version of RESULT

 +1       ; returns P payable, R rejected, or C or D, or "" if no resp packet

 +2        NEW RSP

           DO RESPINFO^ABSPOSQ4(RXI,.RSP)

 +3        QUIT $GET(RSP("RSP"))

 +4       ;