ABSP5B1F ; IHS/OIT/CASSevern/Pieran ran 1/19/2011 - Handling of outgoing NCPDP Billing "B1" Claims for 5.1 (Helper subroutines)
;;1.0;PHARMACY POINT OF SALE;**42**;JUN 21, 2001;Build 38
ADDSEG(SPECIAL,ADDSEG) ;EP CALLED FROM ABSP5B1,ABSP5B2 -- Add segment if we have a field in that segment to send
N NCODE,SEG
S SEG("COB")="^337^338^339^340^443^341^342^431^471^472^"
S SEG("WORKCOMP")="^434^315^316^317^318^319^320^321^327^435^"
S SEG("DURRPPS")="^473^439^440^441^474^475^476^"
S SEG("COUPON")="^485^486^487^"
S SEG("COMPOUND")="^450^451^452^447^488^489^448^449^490^"
S SEG("CLINICAL")="^491^492^424^493^494^495^496^497^499^"
S SEG("PROVIDER")="^465^444^"
S SEG("PRIORAUTH")="^498.01^498.02^498.03^498.04^498.05^498.06^498.07^498.08^498.09^498.11^498.13^498.14^503^"
S NCODE=""
F S NCODE=$O(SPECIAL(NCODE)) Q:NCODE="" D
. N NCTEST
. S NCTEST="^"_NCODE_"^"
. I SEG("PROVIDER")[NCTEST S ADDSEG("PROVIDER")="" K SUPRESSG("Provider") Q
. I SEG("COB")[NCTEST S ADDSEG("COB")="" K SUPRESSG("COB") Q
. I SEG("WORKCOMP")[NCTEST S ADDSEG("WORKCOMP")="" K SUPRESSG("Workers Comp") Q
. I SEG("DURRPPS")[NCTEST S ADDSEG("DURRPPS")="" K SUPRESSG("DURR/PPS") Q
. I SEG("COUPON")[NCTEST S ADDSEG("COUPON")="" K SUPRESSG("Coupon") Q
. I SEG("COMPOUND")[NCTEST S ADDSEG("COMPOUND")="" K SUPRESSG("Compound") Q
. I SEG("CLINICAL")[NCTEST S ADDSEG("CLINICAL")="" K SUPRESSG("Clinical") Q
. I SEG("PRIORAUTH")[NCTEST S ADDSEG("PRIORAUTH")="" K SUPRESSG("Prior Auth")
Q
CHECKOVER(IEN59,SPECIAL) ;EP CALLED FROM ABSP5B1,ABSP5B2 -- Check for manual Over-Rides
N OVRREC,FIELD,VALUE,DO,OVRARRAY
S OVRREC=$P($G(^ABSPT(IEN59,1)),U,13)
Q:OVRREC=""
S DO=OVRREC_","
D GETS^DIQ(9002313.511,DO,"**","","OVRARRAY")
N I
S I=""
F S I=$O(OVRARRAY(9002313.5111,I)) Q:I="" D
. S FIELD=OVRARRAY(9002313.5111,I,.01)
. S VALUE=OVRARRAY(9002313.5111,I,.02)
. S SPECIAL(FIELD)="S ABSP(""X"")="""_VALUE_""""
Q
CHKDUROVR(IEN59,SPECIAL) ;EP CALLED FROM ABSP5B1,ABSP5B2 -- Check for manual Over-Rides
N OVRREC,FIELD,VALUE,DO,OVRARRAY
S OVRREC=$P($G(^ABSPT(IEN59,1)),U,14)
Q:OVRREC=""
S DO=OVRREC_","
D GETS^DIQ(9002313.473,DO,"**","","OVRARRAY")
N I,DUR
S I=""
F S I=$O(OVRARRAY(9002313.4731,I)) Q:I="" D
. S FIELD=.01
. S DUR=OVRARRAY(9002313.4731,I,FIELD)
. F S FIELD=$O(OVRARRAY(9002313.4731,I,FIELD)) Q:FIELD="" D
. . S VALUE=OVRARRAY(9002313.4731,I,FIELD)
. . S SPECIAL(FIELD,DUR)="S ABSP(""X"")="""_VALUE_""""
Q
CHKDIAGOVR(IEN59,SPECIAL) ;EP CALLED FROM ABSP5B1,ABSP5B2 -- Check for manual Over-Rides
N OVRREC,FIELD,VALUE,DO,OVRARRAY
S OVRREC=$P($G(^ABSPT(IEN59,1)),U,17)
Q:OVRREC=""
S DO=OVRREC_","
D GETS^DIQ(9002313.491,DO,"**","","OVRARRAY")
N I,DIAG
S I=""
F S I=$O(OVRARRAY(9002313.4911,I)) Q:I="" D
. S FIELD=.01
. S DIAG=OVRARRAY(9002313.4911,I,FIELD)
. F S FIELD=$O(OVRARRAY(9002313.4911,I,FIELD)) Q:FIELD="" D
. . S VALUE=OVRARRAY(9002313.4911,I,FIELD)
. . S SPECIAL(FIELD,DIAG)="S ABSP(""X"")="""_VALUE_""""
Q
ABSP5B1F ; IHS/OIT/CASSevern/Pieran ran 1/19/2011 - Handling of outgoing NCPDP Billing "B1" Claims for 5.1 (Helper subroutines)
+1 ;;1.0;PHARMACY POINT OF SALE;**42**;JUN 21, 2001;Build 38
ADDSEG(SPECIAL,ADDSEG) ;EP CALLED FROM ABSP5B1,ABSP5B2 -- Add segment if we have a field in that segment to send
+1 NEW NCODE,SEG
+2 SET SEG("COB")="^337^338^339^340^443^341^342^431^471^472^"
+3 SET SEG("WORKCOMP")="^434^315^316^317^318^319^320^321^327^435^"
+4 SET SEG("DURRPPS")="^473^439^440^441^474^475^476^"
+5 SET SEG("COUPON")="^485^486^487^"
+6 SET SEG("COMPOUND")="^450^451^452^447^488^489^448^449^490^"
+7 SET SEG("CLINICAL")="^491^492^424^493^494^495^496^497^499^"
+8 SET SEG("PROVIDER")="^465^444^"
+9 SET SEG("PRIORAUTH")="^498.01^498.02^498.03^498.04^498.05^498.06^498.07^498.08^498.09^498.11^498.13^498.14^503^"
+10 SET NCODE=""
+11 FOR
SET NCODE=$ORDER(SPECIAL(NCODE))
IF NCODE=""
QUIT
Begin DoDot:1
+12 NEW NCTEST
+13 SET NCTEST="^"_NCODE_"^"
+14 IF SEG("PROVIDER")[NCTEST
SET ADDSEG("PROVIDER")=""
KILL SUPRESSG("Provider")
QUIT
+15 IF SEG("COB")[NCTEST
SET ADDSEG("COB")=""
KILL SUPRESSG("COB")
QUIT
+16 IF SEG("WORKCOMP")[NCTEST
SET ADDSEG("WORKCOMP")=""
KILL SUPRESSG("Workers Comp")
QUIT
+17 IF SEG("DURRPPS")[NCTEST
SET ADDSEG("DURRPPS")=""
KILL SUPRESSG("DURR/PPS")
QUIT
+18 IF SEG("COUPON")[NCTEST
SET ADDSEG("COUPON")=""
KILL SUPRESSG("Coupon")
QUIT
+19 IF SEG("COMPOUND")[NCTEST
SET ADDSEG("COMPOUND")=""
KILL SUPRESSG("Compound")
QUIT
+20 IF SEG("CLINICAL")[NCTEST
SET ADDSEG("CLINICAL")=""
KILL SUPRESSG("Clinical")
QUIT
+21 IF SEG("PRIORAUTH")[NCTEST
SET ADDSEG("PRIORAUTH")=""
KILL SUPRESSG("Prior Auth")
End DoDot:1
+22 QUIT
CHECKOVER(IEN59,SPECIAL) ;EP CALLED FROM ABSP5B1,ABSP5B2 -- Check for manual Over-Rides
+1 NEW OVRREC,FIELD,VALUE,DO,OVRARRAY
+2 SET OVRREC=$PIECE($GET(^ABSPT(IEN59,1)),U,13)
+3 IF OVRREC=""
QUIT
+4 SET DO=OVRREC_","
+5 DO GETS^DIQ(9002313.511,DO,"**","","OVRARRAY")
+6 NEW I
+7 SET I=""
+8 FOR
SET I=$ORDER(OVRARRAY(9002313.5111,I))
IF I=""
QUIT
Begin DoDot:1
+9 SET FIELD=OVRARRAY(9002313.5111,I,.01)
+10 SET VALUE=OVRARRAY(9002313.5111,I,.02)
+11 SET SPECIAL(FIELD)="S ABSP(""X"")="""_VALUE_""""
End DoDot:1
+12 QUIT
CHKDUROVR(IEN59,SPECIAL) ;EP CALLED FROM ABSP5B1,ABSP5B2 -- Check for manual Over-Rides
+1 NEW OVRREC,FIELD,VALUE,DO,OVRARRAY
+2 SET OVRREC=$PIECE($GET(^ABSPT(IEN59,1)),U,14)
+3 IF OVRREC=""
QUIT
+4 SET DO=OVRREC_","
+5 DO GETS^DIQ(9002313.473,DO,"**","","OVRARRAY")
+6 NEW I,DUR
+7 SET I=""
+8 FOR
SET I=$ORDER(OVRARRAY(9002313.4731,I))
IF I=""
QUIT
Begin DoDot:1
+9 SET FIELD=.01
+10 SET DUR=OVRARRAY(9002313.4731,I,FIELD)
+11 FOR
SET FIELD=$ORDER(OVRARRAY(9002313.4731,I,FIELD))
IF FIELD=""
QUIT
Begin DoDot:2
+12 SET VALUE=OVRARRAY(9002313.4731,I,FIELD)
+13 SET SPECIAL(FIELD,DUR)="S ABSP(""X"")="""_VALUE_""""
End DoDot:2
End DoDot:1
+14 QUIT
CHKDIAGOVR(IEN59,SPECIAL) ;EP CALLED FROM ABSP5B1,ABSP5B2 -- Check for manual Over-Rides
+1 NEW OVRREC,FIELD,VALUE,DO,OVRARRAY
+2 SET OVRREC=$PIECE($GET(^ABSPT(IEN59,1)),U,17)
+3 IF OVRREC=""
QUIT
+4 SET DO=OVRREC_","
+5 DO GETS^DIQ(9002313.491,DO,"**","","OVRARRAY")
+6 NEW I,DIAG
+7 SET I=""
+8 FOR
SET I=$ORDER(OVRARRAY(9002313.4911,I))
IF I=""
QUIT
Begin DoDot:1
+9 SET FIELD=.01
+10 SET DIAG=OVRARRAY(9002313.4911,I,FIELD)
+11 FOR
SET FIELD=$ORDER(OVRARRAY(9002313.4911,I,FIELD))
IF FIELD=""
QUIT
Begin DoDot:2
+12 SET VALUE=OVRARRAY(9002313.4911,I,FIELD)
+13 SET SPECIAL(FIELD,DIAG)="S ABSP(""X"")="""_VALUE_""""
End DoDot:2
End DoDot:1
+14 QUIT
