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

ABSPOSBF.m

Go to the documentation of this file. 
  1. ABSPOSBF ; IHS/FCS/DRS - ILC/AR comments in 9002302 ; 
  1.  ;;1.0;PHARMACY POINT OF SALE;**48**;JUN 21, 2001;Build 38
  1.  Q
  1. COMMENT(PCNDFN,COMMENT,DATE) ;EP - add a brief comment
  1.  ; If you call it with $$, it returns pointer to the comment
  1.  ; If it fails, the $$ returns false
  1.  ; in ^ABSBITMS(9002302,PCNDFN,"MSG",*)
  1.  N FDA,IEN,MSG,FN S FN=9002302.082
  1.  N X S X="+1,"_PCNDFN_","
  1.  S FDA(FN,X,.01)="NOW"
  1.  N MAX S MAX=45 ; from ^DD(9002302.082,.03)
  1.  I $L(COMMENT)>MAX S COMMENT=$E(COMMENT,1,MAX-3)_"..."
  1.  S FDA(FN,X,.03)=COMMENT
  1.  I $D(DATE) S FDA(FN,X,.04)=DATE
  1.  D UPDATE^DIE("E","FDA","IEN","MSG") ; /IHS/OIT/RAM ; 9 JUN 17 ; LINE UNCHANGED - DBS CALL ALLOWS FOR ERROR RETURN.
  1.  I $D(MSG) D LOG^ABSPOSL2("COMMENT^ABSPOSBF",.MSG) ; /IHS/OIT/RAM ; 9 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
  1.  ;I $D(FDA) ZW FDA
  1.  ;I $D(IEN) ZW IEN
  1.  ;I $D(MSG) ZW MSG
  1.  I $D(MSG) D
  1.  . D LOG^ABSPOSL("COMMENT^"_$T(+0)_" failed for PCNDFN="_PCNDFN)
  1.  . D LOGARRAY^ABSPOSL("MSG")
  1.  Q:$Q $G(IEN(1)) Q
  1. COMMWP(PCNDFN,COMMIEN,ROOT)        ;
  1.  N FDA,IEN,MSG,FN S FN=9002302.082
  1.  D WP^DIE(FN,COMMIEN_","_PCNDFN_",",1,"K",ROOT,"MSG")
  1.  I $D(MSG) D LOG^ABSPOSL2("COMMWP^ABSPOSBF",.MSG) ; /IHS/OIT/RAM ; 9 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
  1.  ; /IHS/OIT/RAM ; 9 JUN 17 ; REMOVED 'SINGLE LINE DO LOOP' BELOW FOR CODE READABILITY.
  1.  I $D(MSG) D LOG^ABSPOSL("COMMWP^"_$T(+0)_" failed for PCNDFN="_PCNDFN_",COMMIEN="_COMMIEN)
  1.  Q:$Q '$D(MSG) ; so it returns true if success, false if failure
  1.  Q
  1. REJECTS(PCNDFN,COMMENT,ARRAY57)        ;EP
  1.  ; Add a comment and then make extended remarks based on claims
  1.  ; in ARRAY57(*).  Returns true/false (did it work?)
  1.  N COMM ; COMM = Pointer: ^ABSBITMS(9002302,PCNDFN,"MSG",COMM)
  1.  S COMM=$$COMMENT(PCNDFN,COMMENT) ; add the general comment, first
  1.  I 'COMM Q 0
  1.  ; and now deal with the details of the rejection
  1.  K ^TMP($J,$T(+0)) N LINE S LINE=0
  1.  N N57,FIRST S N57=0,FIRST=1
  1.  F  S N57=$O(ARRAY57(N57)) Q:'N57  D REJ1 S FIRST=0
  1.  ; Store the word processing field
  1.  N OK S OK=$$COMMWP(PCNDFN,COMM,"^TMP("_$J_","""_$T(+0)_""")")
  1.  Q OK
  1. REJ1 N R0,R1 S R0=^ABSPTL(N57,0),R1=^(1)
  1.  N INSDFN S INSDFN=$P(R1,U,6)
  1.  N INSNAME S INSNAME=$P(^AUTNINS(INSDFN,0),U)
  1.  N RXI S RXI=$P(R0,U)
  1.  N DRGDFN S DRGDFN=$P(^PSRX(RXI,0),U,6)
  1.  N DRGNAME S DRGNAME=$P(^PSDRUG(DRGDFN,0),U)
  1.  N NDC S NDC=$P(R1,U,2),NDC=$$FORMTNDC^ABSPOS9(NDC)
  1.  N CLAIM S CLAIM=$P(R0,U,4)
  1.  N CLAIMID S CLAIMID=$P(^ABSPC(CLAIM,0),U)
  1.  N RESP S RESP=$P(R0,U,5)
  1.  N POS S POS=$P(R0,U,9)
  1.  N TIME,Y S Y=$P(^ABSPR(RESP,0),U,2) X ^DD("DD") S TIME=Y
  1.  D REJX(CLAIMID_"#"_POS_" for "_NDC_" "_DRGNAME)
  1.  D REJX("Rejected by "_INSNAME_" on "_TIME)
  1.  N MSG1 S MSG1=$P($G(^ABSPR(RESP,1000,POS,504)),U)
  1.  I MSG1]"" D REJX(MSG1)
  1.  N MSG2 S MSG2=$P($G(^ABSPR(RESP,1000,POS,526)),U)
  1.  I MSG2]"" D REJX(MSG2)
  1.  N REJ S REJ=""
  1.  F  S REJ=$O(^ABSPR(RESP,1000,POS,511,"B",REJ)) Q:REJ=""  D
  1.  . N MSG S MSG="/"_REJ_" "_$P($G(^ABSPF(9002313.93,REJ,0)),U,2)
  1.  . D REJX(MSG)
  1.  Q
  1. REJX(X) S LINE=LINE+1,^TMP($J,$T(+0),LINE)=X Q  ; used by other subrous, below
  1.  ; Observe:  what we just did lists every rejected claim with
  1.  ; every rejection reason.  It would be nice to cleverly group
  1.  ; things, e.g., to say ALL rejected because of M/I CARDHOLDER NUMBER
  1.  ;
  1.  ; Design for making intelligent comments about rejected claims:
  1.  ;
  1.  ; Build 
  1.  ;  @TMP=count^$ amt of original claims
  1.  ;  @TMP@(N)=drug name
  1.  ;  @TMP@(N,0)=the message from the response packet
  1.  ;  @TMP@(N,reason code)=""
  1.  ;
  1.  ;  @TMP1@(reason code)=count of rejects with this reason ^ reason text
  1.  ;  @TMP1@(reason code,N)="" point back to @TMP@(N)
  1.  ;
  1.  ;  @TMP2@(message)=count
  1.  ;  @TMP2@(message,N)=""   point back to @TMP@(N)
  1.  ;
  1.  ;  @TMP3@($P(ClaimID,"-",1,2),$P(ClaimID,"-",3))=""
  1.  ;      well no, that's already done by the COMMENT we had coming in
  1.  ;
  1.  ;  Then the general form is   <X> REJECTED by <insurer> <Y>
  1.  ; where <X> is either the Drug name or a count of how many
  1.  ;  or the word ALL or BOTH
  1.  ;
  1.  ;  and <Y> is either   : <reasons>
  1.  ;     or :see Claim ID xxxxx
  1.  ;
  1. LIST57(PCNDFN,COMMENT,ARR57) ;EP -
  1.  ; Comment is a list of file 9002313.57 transaction
  1.  ; numbers.  This paragraph is a copy of what's at REJECTS
  1.  N COMM ; COMM = Pointer: ^ABSBITMS(9002302,PCNDFN,"MSG",COMM)
  1.  S COMM=$$COMMENT(PCNDFN,COMMENT) ; add the general comment, first
  1.  I 'COMM Q 0
  1.  ; and now deal with the details of the rejection
  1.  K ^TMP($J,$T(+0)) N LINE S LINE=0
  1.  N N57,FIRST S N57=0,FIRST=1
  1.  F  S N57=$O(ARR57(N57)) Q:'N57  D LIST571 S FIRST=0
  1.  ; Store the word processing field
  1.  N OK S OK=$$COMMWP(PCNDFN,COMM,"^TMP("_$J_","""_$T(+0)_""")")
  1.  Q OK
  1. LIST571 ;
  1.  N R0,R1 S R0=^ABSPTL(N57,0),R1=^ABSPTL(N57,1)
  1.  ; List the transaction #, the claim ID, the position in the claim
  1.  N LAST S LAST=($O(ARR57(N57))="")
  1.  N CLAIM S CLAIM=$P(R0,U,4)
  1.  N CLAIMID,POS
  1.  I CLAIM D
  1.  . S CLAIMID=$P($G(^ABSPC(CLAIM,0)),U),POS=$P(R0,U,9)
  1.  E  S CLAIMID="",POS=""
  1.  N X S X="File 9002313.57 transaction number "_N57
  1.  I CLAIMID]"" S X=X_", Claim ID "_CLAIMID_", position "_POS
  1.  I ARR57(N57)]"" D
  1.  . S X=X_" superseded transaction number "_ARR57(N57)
  1.  I 'LAST S X=X_" / "
  1.  D REJX(X)
  1.  Q
  1. PAYABLE(PCNDFN,COMMENT,ARR57) ;EP - comment on what was paid and how much $$
  1.  ; this paragraph is a copy of what's a REJECTS
  1.  ; with a little bit extra for $ amounts
  1.  ; Also, order of things is switched a little
  1.  K ^TMP($J,$T(+0)) N LINE S LINE=0
  1.  N N57,FIRST S N57=0,FIRST=1
  1.  N PAY ; PAY(*) accumulators
  1.  F  S N57=$O(ARR57(N57)) Q:'N57  D PAY1 S FIRST=0  ; fill the PAY array
  1.  I '$D(PAY) D  Q 0
  1.  . D LOG^ABSPOSL("ERROR - no PAY(*) data? on PCNDFN="_PCNDFN)
  1.  N COMM ; COMM = Pointer: ^ABSBITMS(9002302,PCNDFN,"MSG",COMM)
  1.  S COMM=$$COMMENT(PCNDFN,COMMENT) ; add the general comment, first
  1.  I 'COMM Q 0
  1.  I $G(PAY("00.09 POS Paid"))=$G(PAY("00 POS Billed")) D
  1.  . K PAY("00 POS Billed") ; since it's the same amount
  1.  N X,FIRST S FIRST=1 S X="" F  S X=$O(PAY(X)) Q:X=""  D
  1.  . Q:'PAY(X)  ; don't report zero amounts
  1.  . N % S %=$P(X," ",2,$L(X," "))
  1.  . S %=%_":$"_$J(PAY(X),0,2)
  1.  . I FIRST S FIRST=0
  1.  . E  S %="; "_%
  1.  . D REJX(%)
  1.  ; Store the word processing field
  1.  ;N TMPDBG M TMPDBG=^TMP($J,$T(+0)) ZW TMPDBG R ">>>",%,!
  1.  N OK S OK=$$COMMWP(PCNDFN,COMM,"^TMP("_$J_","""_$T(+0)_""")")
  1.  Q OK
  1. PAY1 ; payment details for transaction N57
  1.  N R0,R1,R5 S R0=^ABSPTL(N57,0),R1=^(1),R5=^(5)
  1.  D ADDPAY("00 POS Billed",$P(R5,U,5))
  1.  N RESP S RESP=$P(R0,U,5)
  1.  N POS S POS=$P(R0,U,9)
  1.  N AMTS S AMTS=^ABSPR(RESP,1000,POS,500)
  1.  D PAY2("00.09 POS Paid",9) ; first " " piece controls order
  1.  D PAY2("05 Patient Pay",5)
  1.  ;D PAY2("07 Contract Fee Paid",7)
  1.  D PAY2("18 Copay",18)
  1.  Q
  1. PAY2(CATEG,AMTSPCE)          ;
  1.  N AMT S AMT=$P(AMTS,U,AMTSPCE) Q:AMT=""
  1.  S AMT=$$DFF2EXT^ABSPECFM(AMT)
  1.  D ADDPAY(CATEG,AMT)
  1.  Q:$Q AMT Q
  1. ADDPAY(CATEG,AMOUNT) S PAY(CATEG)=$G(PAY(CATEG))+AMOUNT Q