ABSPDB1F ; IHS/OIT/CASSevern/Pieran ran 1/19/2011 - Handling of outgoing NCPDP Billing "B1" Claims for D.0 (Helper subroutines)
;;1.0;PHARMACY POINT OF SALE;**42**;JUN 21, 2001;Build 38
ADDSEG(SPECIAL,ADDSEG) ;EP CALLED FROM ABSPDB1,ABSPDB2 -- Add segment if we have a field in that segment to send
N NCODE,SEG
S SEG("COB")="^337^338^339^340^443^993^341^342^431^471^472^353^351^352^392^393^394^"
S SEG("WORKCOMP")="^434^315^316^317^318^319^320^321^327^435^117^118^119^120^121^122^123^124^125^126^"
S SEG("DURRPPS")="^473^439^440^441^474^475^476^"
S SEG("COUPON")="^485^486^487^"
S SEG("COMPOUND")="^450^451^447^488^489^448^449^490^362^363^"
S SEG("CLINICAL")="^491^492^424^493^494^495^496^497^499^"
S SEG("ADDOC")="^369^374^375^373^371^370^372^376^377^378^379^380^381^382^383^"
S SEG("FACILITY")="^336^385^386^388^387^389^"
S SEG("PROVIDER")="^465^444^"
S NCODE=""
F S NCODE=$O(SPECIAL(NCODE)) Q:NCODE="" D
. I NCODE=390 S ADDSEG("NARRATIVE")="" K SUPRESSG("Narrative") Q
. 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("ADDOC")[NCTEST S ADDSEG("ADDOC")="" K SUPRESSG("Additional Doc") Q
. I SEG("FACILITY")[NCTEST S ADDSEG("FACILITY")="" K SUPRESSG("Facility") Q
Q
CHECKOVER(IEN59,SPECIAL) ;EP CALLED FROM ABSPDB1,ABSPDB2 -- 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 ABSPDB1,ABSPDB2 -- 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 ABSPDB1,ABSPDB2 -- 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
ABSPDB1F ; IHS/OIT/CASSevern/Pieran ran 1/19/2011 - Handling of outgoing NCPDP Billing "B1" Claims for D.0 (Helper subroutines)
+1 ;;1.0;PHARMACY POINT OF SALE;**42**;JUN 21, 2001;Build 38
ADDSEG(SPECIAL,ADDSEG) ;EP CALLED FROM ABSPDB1,ABSPDB2 -- 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^993^341^342^431^471^472^353^351^352^392^393^394^"
+3 SET SEG("WORKCOMP")="^434^315^316^317^318^319^320^321^327^435^117^118^119^120^121^122^123^124^125^126^"
+4 SET SEG("DURRPPS")="^473^439^440^441^474^475^476^"
+5 SET SEG("COUPON")="^485^486^487^"
+6 SET SEG("COMPOUND")="^450^451^447^488^489^448^449^490^362^363^"
+7 SET SEG("CLINICAL")="^491^492^424^493^494^495^496^497^499^"
+8 SET SEG("ADDOC")="^369^374^375^373^371^370^372^376^377^378^379^380^381^382^383^"
+9 SET SEG("FACILITY")="^336^385^386^388^387^389^"
+10 SET SEG("PROVIDER")="^465^444^"
+11 SET NCODE=""
+12 FOR
SET NCODE=$ORDER(SPECIAL(NCODE))
IF NCODE=""
QUIT
Begin DoDot:1
+13 IF NCODE=390
SET ADDSEG("NARRATIVE")=""
KILL SUPRESSG("Narrative")
QUIT
+14 NEW NCTEST
+15 SET NCTEST="^"_NCODE_"^"
+16 IF SEG("PROVIDER")[NCTEST
SET ADDSEG("PROVIDER")=""
KILL SUPRESSG("Provider")
QUIT
+17 IF SEG("COB")[NCTEST
SET ADDSEG("COB")=""
KILL SUPRESSG("COB")
QUIT
+18 IF SEG("WORKCOMP")[NCTEST
SET ADDSEG("WORKCOMP")=""
KILL SUPRESSG("Workers Comp")
QUIT
+19 IF SEG("DURRPPS")[NCTEST
SET ADDSEG("DURRPPS")=""
KILL SUPRESSG("DURR/PPS")
QUIT
+20 IF SEG("COUPON")[NCTEST
SET ADDSEG("COUPON")=""
KILL SUPRESSG("Coupon")
QUIT
+21 IF SEG("COMPOUND")[NCTEST
SET ADDSEG("COMPOUND")=""
KILL SUPRESSG("Compound")
QUIT
+22 IF SEG("CLINICAL")[NCTEST
SET ADDSEG("CLINICAL")=""
KILL SUPRESSG("Clinical")
QUIT
+23 IF SEG("ADDOC")[NCTEST
SET ADDSEG("ADDOC")=""
KILL SUPRESSG("Additional Doc")
QUIT
+24 IF SEG("FACILITY")[NCTEST
SET ADDSEG("FACILITY")=""
KILL SUPRESSG("Facility")
QUIT
End DoDot:1
+25 QUIT
CHECKOVER(IEN59,SPECIAL) ;EP CALLED FROM ABSPDB1,ABSPDB2 -- 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 ABSPDB1,ABSPDB2 -- 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 ABSPDB1,ABSPDB2 -- 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
