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