Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABSPDB1F

ABSPDB1F.m

Go to the documentation of this file. 
  1. 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
  1. ADDSEG(SPECIAL,ADDSEG) ;EP CALLED FROM ABSPDB1,ABSPDB2 -- Add segment if we have a field in that segment to send
  1.  N NCODE,SEG
  1.  S SEG("COB")="^337^338^339^340^443^993^341^342^431^471^472^353^351^352^392^393^394^"
  1.  S SEG("WORKCOMP")="^434^315^316^317^318^319^320^321^327^435^117^118^119^120^121^122^123^124^125^126^"
  1.  S SEG("DURRPPS")="^473^439^440^441^474^475^476^"
  1.  S SEG("COUPON")="^485^486^487^"
  1.  S SEG("COMPOUND")="^450^451^447^488^489^448^449^490^362^363^"
  1.  S SEG("CLINICAL")="^491^492^424^493^494^495^496^497^499^"
  1.  S SEG("ADDOC")="^369^374^375^373^371^370^372^376^377^378^379^380^381^382^383^"
  1.  S SEG("FACILITY")="^336^385^386^388^387^389^"
  1.  S SEG("PROVIDER")="^465^444^"
  1.  S NCODE=""
  1.  F  S NCODE=$O(SPECIAL(NCODE)) Q:NCODE=""  D
  1.  . I NCODE=390 S ADDSEG("NARRATIVE")=""  K SUPRESSG("Narrative") Q
  1.  . N NCTEST
  1.  . S NCTEST="^"_NCODE_"^"
  1.  . I SEG("PROVIDER")[NCTEST S ADDSEG("PROVIDER")=""  K SUPRESSG("Provider") Q
  1.  . I SEG("COB")[NCTEST S ADDSEG("COB")=""  K SUPRESSG("COB") Q
  1.  . I SEG("WORKCOMP")[NCTEST S ADDSEG("WORKCOMP")=""  K SUPRESSG("Workers Comp") Q
  1.  . I SEG("DURRPPS")[NCTEST S ADDSEG("DURRPPS")=""  K SUPRESSG("DURR/PPS") Q
  1.  . I SEG("COUPON")[NCTEST S ADDSEG("COUPON")=""   K SUPRESSG("Coupon") Q
  1.  . I SEG("COMPOUND")[NCTEST S ADDSEG("COMPOUND")=""  K SUPRESSG("Compound") Q
  1.  . I SEG("CLINICAL")[NCTEST S ADDSEG("CLINICAL")=""  K SUPRESSG("Clinical") Q
  1.  . I SEG("ADDOC")[NCTEST S ADDSEG("ADDOC")=""  K SUPRESSG("Additional Doc") Q
  1.  . I SEG("FACILITY")[NCTEST S ADDSEG("FACILITY")=""  K SUPRESSG("Facility") Q
  1.  Q
  1. CHECKOVER(IEN59,SPECIAL) ;EP CALLED FROM ABSPDB1,ABSPDB2 -- Check for manual Over-Rides
  1.  N OVRREC,FIELD,VALUE,DO,OVRARRAY
  1.  S OVRREC=$P($G(^ABSPT(IEN59,1)),U,13)
  1.  Q:OVRREC=""
  1.  S DO=OVRREC_","
  1.  D GETS^DIQ(9002313.511,DO,"**","","OVRARRAY")
  1.  N I
  1.  S I=""
  1.  F  S I=$O(OVRARRAY(9002313.5111,I)) Q:I=""  D
  1.  . S FIELD=OVRARRAY(9002313.5111,I,.01)
  1.  . S VALUE=OVRARRAY(9002313.5111,I,.02)
  1.  . S SPECIAL(FIELD)="S ABSP(""X"")="""_VALUE_""""
  1.  Q
  1. CHKDUROVR(IEN59,SPECIAL) ;EP CALLED FROM ABSPDB1,ABSPDB2 -- Check for manual Over-Rides
  1.  N OVRREC,FIELD,VALUE,DO,OVRARRAY
  1.  S OVRREC=$P($G(^ABSPT(IEN59,1)),U,14)
  1.  Q:OVRREC=""
  1.  S DO=OVRREC_","
  1.  D GETS^DIQ(9002313.473,DO,"**","","OVRARRAY")
  1.  N I,DUR
  1.  S I=""
  1.  F  S I=$O(OVRARRAY(9002313.4731,I)) Q:I=""  D
  1.  . S FIELD=.01
  1.  . S DUR=OVRARRAY(9002313.4731,I,FIELD)
  1.  . F  S FIELD=$O(OVRARRAY(9002313.4731,I,FIELD)) Q:FIELD=""  D
  1.  . . S VALUE=OVRARRAY(9002313.4731,I,FIELD)
  1.  . . S SPECIAL(FIELD,DUR)="S ABSP(""X"")="""_VALUE_""""
  1.  Q
  1. CHKDIAGOVR(IEN59,SPECIAL) ;EP CALLED FROM ABSPDB1,ABSPDB2 -- Check for manual Over-Rides
  1.  N OVRREC,FIELD,VALUE,DO,OVRARRAY
  1.  S OVRREC=$P($G(^ABSPT(IEN59,1)),U,17)
  1.  Q:OVRREC=""
  1.  S DO=OVRREC_","
  1.  D GETS^DIQ(9002313.491,DO,"**","","OVRARRAY")
  1.  N I,DIAG
  1.  S I=""
  1.  F  S I=$O(OVRARRAY(9002313.4911,I)) Q:I=""  D
  1.  . S FIELD=.01
  1.  . S DIAG=OVRARRAY(9002313.4911,I,FIELD)
  1.  . F  S FIELD=$O(OVRARRAY(9002313.4911,I,FIELD)) Q:FIELD=""  D
  1.  . . S VALUE=OVRARRAY(9002313.4911,I,FIELD)
  1.  . . S SPECIAL(FIELD,DIAG)="S ABSP(""X"")="""_VALUE_""""
  1.  Q