- 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