ABSPER4A ; IHS/FCS/DRS - JWS 10:29 AM 17 Jul 1996 ; [ 09/12/2002 10:03 AM ]
;;1.0;PHARMACY POINT OF SALE;**3**;JUN 21, 2001;Build 38
;----------------------------------------------------------------------
;----------------------------------------------------------------------
;Pharmacy Claim Rejection Report - CODE 40 - (by Tran Date, Sorted by Insurer)
;----------------------------------------------------------------------
W @IOF ;D ^AUCLS
W $$LJBF^ABSPOSU9(SCRNTXT,IOM-10)_$$LJBF^ABSPOSU9("PAGE "_PAGE,10),!
W $TR($J("",IOM)," ","-"),!
Q
;----------------------------------------------------------------------
W !
W "Insurer:",?11,$$LJBF^ABSPOSU9(INSNAME,46)
W ?61,"Help #:",?70,$$LJBF^ABSPOSU9($G(^TMP($J,RPTNAME,INSNAME)),20)
W ?92,"Transmission Dates:"
W ?113,$$LJBF^ABSPOSU9($$FM2MDY^ABSPOSU1(SDATE),8)_" - "
W $$LJBF^ABSPOSU9($$FM2MDY^ABSPOSU1(EDATE),8),!
;D WCOLUMNS^ABSPOSU9(0,2,"Trans On:8,Claim ID:16,"_$P($G(^ABSP(9002313.99,PSIEN,2)),U,1)_" #:12,Patient Name:20,Cardholder ID:15,NDC #:13,Rejection Reason(s):36",1)
D WCOLUMNS^ABSPOSU9(0,2,"Patient Name:20,"_$P($G(^ABSP(9002313.99,PSIEN,2)),U,1)_" #:12,MCAID #:15,Date Filled:8,Presc.#:12,NDC #:13,QTY:3,Days Supply:11,Charge:8",1)
Q
;----------------------------------------------------------------------
PRINT ;EP - from ABSPER40
N FLAG,INSNAME,TDATE,ANS,RESPIEN,MEDIEN,DATA,TRANSON,CLAIMID,VCN
N PATNAME,CARDID,NDC,RJCTCNT,RJCTN,RJCTTEXT,CHG,MCAID,QTY,SUP
I IOM<132 D Q
.D HEADER1
.W !,"Device selected does not support 132 column reports.",!
.D:(IO=$P) PRESSANY^ABSPOSU5(1,DTIME)
S FLAG=0,INSNAME=""
F D Q:INSNAME=""!(FLAG)
.S INSNAME=$O(^TMP($J,RPTNAME,INSNAME))
.Q:INSNAME=""
.D HEADER1,HEADER2
.S TDATE=""
.F D Q:'+TDATE!(FLAG)
..S TDATE=$O(^TMP($J,RPTNAME,INSNAME,TDATE))
..Q:'+TDATE
..S RESPIEN=""
..F D Q:'+RESPIEN!(FLAG)
...S RESPIEN=$O(^TMP($J,RPTNAME,INSNAME,TDATE,RESPIEN))
...Q:'+RESPIEN
...S MEDIEN=""
...F D Q:'+MEDIEN!(FLAG)
....S MEDIEN=$O(^TMP($J,RPTNAME,INSNAME,TDATE,RESPIEN,MEDIEN))
....Q:'+MEDIEN
....S DATA=$G(^TMP($J,RPTNAME,INSNAME,TDATE,RESPIEN,MEDIEN))
....S TRANSON=$$FM2MDY^ABSPOSU1(TDATE)
....S CLAIMID=$P(DATA,U,1)
....S VCN=$P(DATA,U,2)
....S PATNAME=$P(DATA,U,3)
....S CARDID=$P(DATA,U,4)
....S MCAID=999999
....S QTY="TST"
....S SUP="TST"
....S CHG=500
....S NDC=$P(DATA,U,5)
....S RJCTCNT=$P(DATA,U,6)
....F RJCTN=1:1:RJCTCNT D Q:FLAG
.....S RJCTTEXT=$G(^TMP($J,RPTNAME,INSNAME,TDATE,RESPIEN,MEDIEN,RJCTN))
.....S:RJCTTEXT="" RJCTTEXT="Undefined Error"
.....I ($Y+2)>IOSL,'(IO=$P) D HEADER1,HEADER2
.....I ($Y+2)>IOSL,(IO=$P),($E(IOST,1,1)="C") D
......S ANS=$$ENDPAGE^ABSPOSU5(0,DTIME)
......S:ANS=-1!(ANS="^") FLAG=1
......I 'FLAG D HEADER1,HEADER2
.....D:'FLAG&(RJCTN=1) WDATA^ABSPOSU9(0,2,"PATNAME:20,VCN:12,MCAID:15,TDATE:8,MEDIEN:12,NDC:13,QTY:3,SUP:11,CHG:8")
.....D:'FLAG&(RJCTN>1) WDATA^ABSPOSU9(96,0,"RJCTTEXT:36")
Q:FLAG
D:(IO=$P) PRESSANY^ABSPOSU5(1,DTIME)
Q
ABSPER4A ; IHS/FCS/DRS - JWS 10:29 AM 17 Jul 1996 ; [ 09/12/2002 10:03 AM ]
+1 ;;1.0;PHARMACY POINT OF SALE;**3**;JUN 21, 2001;Build 38
+2 ;----------------------------------------------------------------------
+3 ;----------------------------------------------------------------------
+4 ;Pharmacy Claim Rejection Report - CODE 40 - (by Tran Date, Sorted by Insurer)
+5 ;----------------------------------------------------------------------
+1 ;D ^AUCLS
WRITE @IOF
+2 WRITE $$LJBF^ABSPOSU9(SCRNTXT,IOM-10)_$$LJBF^ABSPOSU9("PAGE "_PAGE,10),!
+3 WRITE $TRANSLATE($JUSTIFY("",IOM)," ","-"),!
+4 QUIT
+5 ;----------------------------------------------------------------------
NEW PSIEN
SET PSIEN=1
+1 WRITE !
+2 WRITE "Insurer:",?11,$$LJBF^ABSPOSU9(INSNAME,46)
+3 WRITE ?61,"Help #:",?70,$$LJBF^ABSPOSU9($GET(^TMP($JOB,RPTNAME,INSNAME)),20)
+4 WRITE ?92,"Transmission Dates:"
+5 WRITE ?113,$$LJBF^ABSPOSU9($$FM2MDY^ABSPOSU1(SDATE),8)_" - "
+6 WRITE $$LJBF^ABSPOSU9($$FM2MDY^ABSPOSU1(EDATE),8),!
+7 ;D WCOLUMNS^ABSPOSU9(0,2,"Trans On:8,Claim ID:16,"_$P($G(^ABSP(9002313.99,PSIEN,2)),U,1)_" #:12,Patient Name:20,Cardholder ID:15,NDC #:13,Rejection Reason(s):36",1)
+8 DO WCOLUMNS^ABSPOSU9(0,2,"Patient Name:20,"_$PIECE($GET(^ABSP(9002313.99,PSIEN,2)),U,1)_" #:12,MCAID #:15,Date Filled:8,Presc.#:12,NDC #:13,QTY:3,Days Supply:11,Charge:8",1)
+9 QUIT
+10 ;----------------------------------------------------------------------
PRINT ;EP - from ABSPER40
+1 NEW FLAG,INSNAME,TDATE,ANS,RESPIEN,MEDIEN,DATA,TRANSON,CLAIMID,VCN
+2 NEW PATNAME,CARDID,NDC,RJCTCNT,RJCTN,RJCTTEXT,CHG,MCAID,QTY,SUP
+3 IF IOM<132
Begin DoDot:1
+4 DO HEADER1
+5 WRITE !,"Device selected does not support 132 column reports.",!
+6 IF (IO=$PRINCIPAL)
DO PRESSANY^ABSPOSU5(1,DTIME)
End DoDot:1
QUIT
+7 SET FLAG=0
SET INSNAME=""
+8 FOR
Begin DoDot:1
+9 SET INSNAME=$ORDER(^TMP($JOB,RPTNAME,INSNAME))
+10 IF INSNAME=""
QUIT
+11 DO HEADER1
DO HEADER2
+12 SET TDATE=""
+13 FOR
Begin DoDot:2
+14 SET TDATE=$ORDER(^TMP($JOB,RPTNAME,INSNAME,TDATE))
+15 IF '+TDATE
QUIT
+16 SET RESPIEN=""
+17 FOR
Begin DoDot:3
+18 SET RESPIEN=$ORDER(^TMP($JOB,RPTNAME,INSNAME,TDATE,RESPIEN))
+19 IF '+RESPIEN
QUIT
+20 SET MEDIEN=""
+21 FOR
Begin DoDot:4
+22 SET MEDIEN=$ORDER(^TMP($JOB,RPTNAME,INSNAME,TDATE,RESPIEN,MEDIEN))
+23 IF '+MEDIEN
QUIT
+24 SET DATA=$GET(^TMP($JOB,RPTNAME,INSNAME,TDATE,RESPIEN,MEDIEN))
+25 SET TRANSON=$$FM2MDY^ABSPOSU1(TDATE)
+26 SET CLAIMID=$PIECE(DATA,U,1)
+27 SET VCN=$PIECE(DATA,U,2)
+28 SET PATNAME=$PIECE(DATA,U,3)
+29 SET CARDID=$PIECE(DATA,U,4)
+30 SET MCAID=999999
+31 SET QTY="TST"
+32 SET SUP="TST"
+33 SET CHG=500
+34 SET NDC=$PIECE(DATA,U,5)
+35 SET RJCTCNT=$PIECE(DATA,U,6)
+36 FOR RJCTN=1:1:RJCTCNT
Begin DoDot:5
+37 SET RJCTTEXT=$GET(^TMP($JOB,RPTNAME,INSNAME,TDATE,RESPIEN,MEDIEN,RJCTN))
+38 IF RJCTTEXT=""
SET RJCTTEXT="Undefined Error"
+39 IF ($Y+2)>IOSL
IF '(IO=$PRINCIPAL)
DO HEADER1
DO HEADER2
+40 IF ($Y+2)>IOSL
IF (IO=$PRINCIPAL)
IF ($EXTRACT(IOST,1,1)="C")
Begin DoDot:6
+41 SET ANS=$$ENDPAGE^ABSPOSU5(0,DTIME)
+42 IF ANS=-1!(ANS="^")
SET FLAG=1
+43 IF 'FLAG
DO HEADER1
DO HEADER2
End DoDot:6
+44 IF 'FLAG&(RJCTN=1)
DO WDATA^ABSPOSU9(0,2,"PATNAME:20,VCN:12,MCAID:15,TDATE:8,MEDIEN:12,NDC:13,QTY:3,SUP:11,CHG:8")
+45 IF 'FLAG&(RJCTN>1)
DO WDATA^ABSPOSU9(96,0,"RJCTTEXT:36")
End DoDot:5
IF FLAG
QUIT
End DoDot:4
IF '+MEDIEN!(FLAG)
QUIT
End DoDot:3
IF '+RESPIEN!(FLAG)
QUIT
End DoDot:2
IF '+TDATE!(FLAG)
QUIT
End DoDot:1
IF INSNAME=""!(FLAG)
QUIT
+46 IF FLAG
QUIT
+47 IF (IO=$PRINCIPAL)
DO PRESSANY^ABSPOSU5(1,DTIME)
+48 QUIT
