Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABSPOSUC

ABSPOSUC.m

Go to the documentation of this file. 
  1. ABSPOSUC ; IHS/FCS/DRS - POS utilities ;     
  1.  ;;1.0;PHARMACY POINT OF SALE;;JUN 21, 2001
  1.  Q
  1.  ; CATEG is used by ILC billing in ABSPOSB2
  1.  ; Also called by several other routines
  1. CATEG(N,WANTREV) ;EP - many
  1.  ; given N, return category for the duplicate resolution process
  1.  ; Can call with either N = integer IEN into 9002313.57
  1.  ;   or N = decimal IEN into 9002313.59
  1.  ; $G(WANTREV) = true if you care about reversals 
  1.  ;         (that's the default if N is an IEN59)
  1.  ; $G(WANTREV) = false if you want to ignore reversals 
  1.  ;         (that's the default if IEN57)
  1.  ; because billing is handled differently.
  1.  ;
  1.  ; Many routines rely on these exact return values; do not change them:
  1.  ; Return values:  PAPER, E PAYABLE, E CAPTURED, E DUPLICATE,
  1.  ;                 E REJECTED, E OTHER
  1.  ;            and  CANCELLED (two L's) (only for 9002313.59)
  1.  ;
  1.  ;   E DUPLICATE - being phased out - 02/06/2001
  1.  ;   remap to E PAYABLE or E CAPTURED, as appropriate
  1.  ;
  1.  ; and if you want to consider reversals, 
  1.  ;     PAPER REVERSAL, E REVERSAL ACCEPTED, E REVERSAL REJECTED
  1.  ;     or E REVERSAL OTHER
  1.  ; (CORRUPT, E OTHER and E REVERSAL OTHER should never happen)
  1.  ;
  1.  ;
  1.  I N<1 Q "" ; N=-1 can happen from print templates, e.g. MISSED PRESC
  1.  N FILENUM S FILENUM=$S(N[".":9002313.59,1:9002313.57)
  1.  I '$D(WANTREV) S WANTREV=$S(FILENUM=9002313.57:0,FILENUM=9002313.59:1)
  1.  N RETVAL,CLAIM,RESP,REV,X,RESULT
  1.  I '$$GET1^DIQ(FILENUM,N_",",.01) Q "CORRUPT"
  1.  S CLAIM=$$GET1^DIQ(FILENUM,N_",",3,"I")
  1.  S RESP=$$GET1^DIQ(FILENUM,N_",",4,"I")
  1.  I 'CLAIM S RETVAL="PAPER" D  Q RETVAL
  1.  . I 'WANTREV Q
  1.  . I $$GET1^DIQ(FILENUM,N_",",403,"I") S RETVAL=RETVAL_" REVERSAL"
  1.  ; otherwise, there is an electronic claim and you get an "E xxxxxx"
  1.  ;S RESULT=$$GET1^DIQ(FILENUM,N_",",202)
  1.  ;S RESULT=$G(^ABSPEC(FILENUM,N,2))
  1.  I $$GET1^DIQ(FILENUM,N_",",302) Q "CANCELLED"
  1.  I WANTREV S X=$$GET1^DIQ(FILENUM,N_",",401,"I") I X D  Q RETVAL
  1.  . S RETVAL="E REVERSAL "
  1.  . S RESP=$$GET1^DIQ(FILENUM,N_",",402,"I")
  1.  . I 'RESP S RETVAL="E OTHER" Q
  1.  . S X=$$RESP500^ABSPOSQ4(RESP,"I")
  1.  . S RETVAL=RETVAL_$S(X="A":"ACCEPTED",X="R":"REJECTED",1:"OTHER")
  1.  ; Electronic claim, don't want to consider reversal
  1.  I 'RESP D  Q RETVAL
  1.  . S RETVAL="E OTHER" ; electronic claim but no response?
  1.  N RESP500 S RESP500=$$RESP500^ABSPOSQ4(RESP,"I")
  1.  ; Give precedence to the particular response in 1000
  1.  ;I X="R" Q "E REJECTED" ; 10/26/2000 ; Oklahoma Medicaid might give
  1.  ; a rejected header as well as a rejected prescription therein
  1.  ;I X'="A" Q "E OTHER" ; rejected header?  corrupt? rejected reversal?
  1.  N POS S POS=$$GET1^DIQ(FILENUM,N_",",14)
  1.  S X=$$RESP1000^ABSPOSQ4(RESP,POS,"I")
  1.  I X="P"!(X="DP") Q "E PAYABLE"
  1.  I X="D" Q "E DUPLICATE" ; SHOULD NEVER HAPPEN as of 02/06/2001
  1.  I X="R" Q "E REJECTED"
  1.  I X="C"!(X="DC") Q "E CAPTURED"
  1.  ; 1000 indefinite, fall back to 500
  1.  I RESP500="R" Q "E REJECTED"
  1.  Q "E OTHER" ; corrupt?