ABSPOSUC.m

ABSPOSUC ; IHS/FCS/DRS - POS utilities ;     

 ;;1.0;PHARMACY POINT OF SALE;;JUN 21, 2001

 Q

 ; CATEG is used by ILC billing in ABSPOSB2

 ; Also called by several other routines

CATEG(N,WANTREV) ;EP - many

 ; given N, return category for the duplicate resolution process

 ; Can call with either N = integer IEN into 9002313.57

 ;   or N = decimal IEN into 9002313.59

 ; $G(WANTREV) = true if you care about reversals 

 ;         (that's the default if N is an IEN59)

 ; $G(WANTREV) = false if you want to ignore reversals 

 ;         (that's the default if IEN57)

 ; because billing is handled differently.

 ;

 ; Many routines rely on these exact return values; do not change them:

 ; Return values:  PAPER, E PAYABLE, E CAPTURED, E DUPLICATE,

 ;                 E REJECTED, E OTHER

 ;            and  CANCELLED (two L's) (only for 9002313.59)

 ;

 ;   E DUPLICATE - being phased out - 02/06/2001

 ;   remap to E PAYABLE or E CAPTURED, as appropriate

 ;

 ; and if you want to consider reversals, 

 ;     PAPER REVERSAL, E REVERSAL ACCEPTED, E REVERSAL REJECTED

 ;     or E REVERSAL OTHER

 ; (CORRUPT, E OTHER and E REVERSAL OTHER should never happen)

 ;

 ;

 I N<1 Q "" ; N=-1 can happen from print templates, e.g. MISSED PRESC

 N FILENUM S FILENUM=$S(N[".":9002313.59,1:9002313.57)

 I '$D(WANTREV) S WANTREV=$S(FILENUM=9002313.57:0,FILENUM=9002313.59:1)

 N RETVAL,CLAIM,RESP,REV,X,RESULT

 I '$$GET1^DIQ(FILENUM,N_",",.01) Q "CORRUPT"

 S CLAIM=$$GET1^DIQ(FILENUM,N_",",3,"I")

 S RESP=$$GET1^DIQ(FILENUM,N_",",4,"I")

 I 'CLAIM S RETVAL="PAPER" D  Q RETVAL

 . I 'WANTREV Q

 . I $$GET1^DIQ(FILENUM,N_",",403,"I") S RETVAL=RETVAL_" REVERSAL"

 ; otherwise, there is an electronic claim and you get an "E xxxxxx"

 ;S RESULT=$$GET1^DIQ(FILENUM,N_",",202)

 ;S RESULT=$G(^ABSPEC(FILENUM,N,2))

 I $$GET1^DIQ(FILENUM,N_",",302) Q "CANCELLED"

 I WANTREV S X=$$GET1^DIQ(FILENUM,N_",",401,"I") I X D  Q RETVAL

 . S RETVAL="E REVERSAL "

 . S RESP=$$GET1^DIQ(FILENUM,N_",",402,"I")

 . I 'RESP S RETVAL="E OTHER" Q

 . S X=$$RESP500^ABSPOSQ4(RESP,"I")

 . S RETVAL=RETVAL_$S(X="A":"ACCEPTED",X="R":"REJECTED",1:"OTHER")

 ; Electronic claim, don't want to consider reversal

 I 'RESP D  Q RETVAL

 . S RETVAL="E OTHER" ; electronic claim but no response?

 N RESP500 S RESP500=$$RESP500^ABSPOSQ4(RESP,"I")

 ; Give precedence to the particular response in 1000

 ;I X="R" Q "E REJECTED" ; 10/26/2000 ; Oklahoma Medicaid might give

 ; a rejected header as well as a rejected prescription therein

 ;I X'="A" Q "E OTHER" ; rejected header?  corrupt? rejected reversal?

 N POS S POS=$$GET1^DIQ(FILENUM,N_",",14)

 S X=$$RESP1000^ABSPOSQ4(RESP,POS,"I")

 I X="P"!(X="DP") Q "E PAYABLE"

 I X="D" Q "E DUPLICATE" ; SHOULD NEVER HAPPEN as of 02/06/2001

 I X="R" Q "E REJECTED"

 I X="C"!(X="DC") Q "E CAPTURED"

 ; 1000 indefinite, fall back to 500

 I RESP500="R" Q "E REJECTED"

 Q "E OTHER" ; corrupt?

ABSPOSUC  ; IHS/FCS/DRS - POS utilities ;     

 +1       ;;1.0;PHARMACY POINT OF SALE;;JUN 21, 2001

 +2        QUIT 

 +3       ; CATEG is used by ILC billing in ABSPOSB2

 +4       ; Also called by several other routines

CATEG(N,WANTREV) ;EP - many

 +1       ; given N, return category for the duplicate resolution process

 +2       ; Can call with either N = integer IEN into 9002313.57

 +3       ;   or N = decimal IEN into 9002313.59

 +4       ; $G(WANTREV) = true if you care about reversals 

 +5       ;         (that's the default if N is an IEN59)

 +6       ; $G(WANTREV) = false if you want to ignore reversals 

 +7       ;         (that's the default if IEN57)

 +8       ; because billing is handled differently.

 +9       ;

 +10      ; Many routines rely on these exact return values; do not change them:

 +11      ; Return values:  PAPER, E PAYABLE, E CAPTURED, E DUPLICATE,

 +12      ;                 E REJECTED, E OTHER

 +13      ;            and  CANCELLED (two L's) (only for 9002313.59)

 +14      ;

 +15      ;   E DUPLICATE - being phased out - 02/06/2001

 +16      ;   remap to E PAYABLE or E CAPTURED, as appropriate

 +17      ;

 +18      ; and if you want to consider reversals, 

 +19      ;     PAPER REVERSAL, E REVERSAL ACCEPTED, E REVERSAL REJECTED

 +20      ;     or E REVERSAL OTHER

 +21      ; (CORRUPT, E OTHER and E REVERSAL OTHER should never happen)

 +22      ;

 +23      ;

 +24      ; N=-1 can happen from print templates, e.g. MISSED PRESC

           IF N<1

               QUIT ""

 +25       NEW FILENUM

           SET FILENUM=$SELECT(N[".":9002313.59,1:9002313.57)

 +26       IF '$DATA(WANTREV)

               SET WANTREV=$SELECT(FILENUM=9002313.57:0,FILENUM=9002313.59:1)

 +27       NEW RETVAL,CLAIM,RESP,REV,X,RESULT

 +28       IF '$$GET1^DIQ(FILENUM,N_",",.01)

               QUIT "CORRUPT"

 +29       SET CLAIM=$$GET1^DIQ(FILENUM,N_",",3,"I")

 +30       SET RESP=$$GET1^DIQ(FILENUM,N_",",4,"I")

 +31       IF 'CLAIM

               SET RETVAL="PAPER"

               Begin DoDot:1

 +32               IF 'WANTREV

                       QUIT 

 +33               IF $$GET1^DIQ(FILENUM,N_",",403,"I")

                       SET RETVAL=RETVAL_" REVERSAL"

               End DoDot:1

               QUIT RETVAL

 +34      ; otherwise, there is an electronic claim and you get an "E xxxxxx"

 +35      ;S RESULT=$$GET1^DIQ(FILENUM,N_",",202)

 +36      ;S RESULT=$G(^ABSPEC(FILENUM,N,2))

 +37       IF $$GET1^DIQ(FILENUM,N_",",302)

               QUIT "CANCELLED"

 +38       IF WANTREV

               SET X=$$GET1^DIQ(FILENUM,N_",",401,"I")

               IF X

                   Begin DoDot:1

 +39                   SET RETVAL="E REVERSAL "

 +40                   SET RESP=$$GET1^DIQ(FILENUM,N_",",402,"I")

 +41                   IF 'RESP

                           SET RETVAL="E OTHER"

                           QUIT 

 +42                   SET X=$$RESP500^ABSPOSQ4(RESP,"I")

 +43                   SET RETVAL=RETVAL_$SELECT(X="A":"ACCEPTED",X="R":"REJECTED",1:"OTHER")

                   End DoDot:1

                   QUIT RETVAL

 +44      ; Electronic claim, don't want to consider reversal

 +45       IF 'RESP

               Begin DoDot:1

 +46      ; electronic claim but no response?

                   SET RETVAL="E OTHER"

               End DoDot:1

               QUIT RETVAL

 +47       NEW RESP500

           SET RESP500=$$RESP500^ABSPOSQ4(RESP,"I")

 +48      ; Give precedence to the particular response in 1000

 +49      ;I X="R" Q "E REJECTED" ; 10/26/2000 ; Oklahoma Medicaid might give

 +50      ; a rejected header as well as a rejected prescription therein

 +51      ;I X'="A" Q "E OTHER" ; rejected header?  corrupt? rejected reversal?

 +52       NEW POS

           SET POS=$$GET1^DIQ(FILENUM,N_",",14)

 +53       SET X=$$RESP1000^ABSPOSQ4(RESP,POS,"I")

 +54       IF X="P"!(X="DP")

               QUIT "E PAYABLE"

 +55      ; SHOULD NEVER HAPPEN as of 02/06/2001

           IF X="D"

               QUIT "E DUPLICATE"

 +56       IF X="R"

               QUIT "E REJECTED"

 +57       IF X="C"!(X="DC")

               QUIT "E CAPTURED"

 +58      ; 1000 indefinite, fall back to 500

 +59       IF RESP500="R"

               QUIT "E REJECTED"

 +60      ; corrupt?

           QUIT "E OTHER"