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

ABSPDB1.m

Go to the documentation of this file. 
  1. ABSPDB1 ; IHS/OIT/CASSevern/Pieran ran 1/19/2011 - Handling of outgoing NCPDP Billing "B1" and Reversal "B2" Claims for D.0
  1.  ;;1.0;PHARMACY POINT OF SALE;**42**;JUN 21, 2001;Build 38
  1.  ;
  1.  ; This routine will replace the ABSPOSCF for D.0, so that we no
  1.  ; longer need to use the formats file.
  1.  ; This will go through and get the data for each and every segment and field
  1.  ; format it and place it in the CLAIM file ^ABSPC(CLAIMIEN
  1.  ; The ABSP() Array is already set up in: GETINFO^ABSPOSCC before we get here.
  1.  ;INPUT = ACTION
  1.  ;		  "CLAIMHD" = Set up only the claim header for creating ^ABSPC entry
  1.  ;		  "CLAIMRST" = Set up Rest of Claim info and fill in ^ABSPC entry
  1.  ;		  "OUTHD"	= Create the actual Output HEADER Record
  1.  ;		  "OUTRST"  = Create the actual Output Rest of the Record.
  1. EN(ACTION,MEDN,IEN) ;EP
  1.  N INSARRAY,DO,SPECIAL,SUPRESF
  1.  S RECORD=$G(RECORD)
  1.  I ACTION["CLAIM" D
  1.  . S DO=ABSP("Insurer","IEN")_","
  1.  ELSE  D
  1.  . S DO=IEN("9002313.4")_","
  1.  D GETS^DIQ(9002313.4,DO,"100.15;100.16;100.17;200.01;210*;215*;220*","","INSARRAY")
  1.  I $D(INSARRAY(9002313.42)) D SETSPEC
  1.  I $D(INSARRAY(9002313.48)) D SETSUPRSG
  1.  I $D(INSARRAY(9002313.46)) D SETSUPRF
  1.  D CHECKOVER^ABSPDB1F(D0,.SPECIAL) ;Check for Manual Over-Rides for this Claim
  1.  D CHKDUROVR^ABSPDB1F(D0,.SPECIAL) ;Don't forget the DUR over-rides
  1.  D CHKDIAGOVR^ABSPDB1F(D0,.SPECIAL) ;Don't forget the DUR over-rides
  1.  I $D(SPECIAL) D ADDSEG^ABSPDB1F(.SPECIAL,.ADDSEG) ;Figure out based on Special fields which segments we need
  1.  I (ACTION="CLAIMHD")!(ACTION="OUTHD") D
  1.  . D HEADER^ABSPDB1G ;Every time
  1.  . D INSURANCE^ABSPDB1G ;Every time
  1.  . D PATIENT^ABSPDB1G ;Every time
  1.  I (ACTION="CLAIMRST")!(ACTION="OUTRST") D
  1.  . I +$G(IEN(9002313.01))=0 S IEN(9002313.01)=1
  1.  . D CLAIM^ABSPDB1A ;Every time
  1.  . D PRICING^ABSPDB1B ;Pretty much every time
  1.  . I $D(ADDSEG("PROVIDER")) D PROVIDER^ABSPDB1B ;Almost never (Currently 2 formats)
  1.  . D PRESCRIBER^ABSPDB1B ;Pretty much every time
  1.  . I $D(ADDSEG("COB")) D COB^ABSPDB1C ;Not Currently implemented
  1.  . I $D(ADDSEG("WORKCOMP")) D WORKCOMP^ABSPDB1C ;Not Currently implemented
  1.  . I $D(ADDSEG("DURRPPS")) D DURRPPS^ABSPDB1D ;Very common...but for over-rides only
  1.  . I $D(ADDSEG("COUPON")) D COUPON^ABSPDB1D ;Not Currently implemented
  1.  . I $D(ADDSEG("COMPOUND")) D COMPOUND^ABSPDB1D ;Not currently implemented
  1.  . I $D(ADDSEG("CLINICAL")) D CLINICAL^ABSPDB1D ;Fairly rarely  (Currently 57 formats for Over-ride only)
  1.  . I $D(ADDSEG("ADDOC")) D ADDDOC^ABSPDB1E ;Not Currently implemented
  1.  . I $D(ADDSEG("FACILITY")) D FACILITY^ABSPDB1E ;Not Currently implemented
  1.  . I $D(ADDSEG("NARRATIVE")) D NARRATIVE^ABSPDB1E ;Not Currently implemented
  1.  Q
  1. SETSPEC ;SET UP SPECIAL CODE ARRAY HERE.
  1.  N D1,NCODE,MUMPS
  1.  S D1=""
  1.  F  S D1=$O(INSARRAY(9002313.42,D1)) Q:D1=""  D
  1.  . S NCODE=$G(INSARRAY(9002313.42,D1,.01))
  1.  . S MUMPS=$G(INSARRAY(9002313.42,D1,.02))
  1.  . S:MUMPS["ABSP(""X"")" MUMPS=$TR(MUMPS,"|","^") ;If we stripped out caret (^) during conversion....put back in here
  1.  . I MUMPS'["ABSP(""X"")" S MUMPS="S ABSP(""X"")="""_MUMPS_""""
  1.  . S SPECIAL(NCODE)=MUMPS
  1.  Q
  1. SETSUPRSG ;SET UP SUPPRESS SEGMENT ARRAY HERE.
  1.  N D1,SCODE
  1.  S D1=""
  1.  F  S D1=$O(INSARRAY(9002313.48,D1)) Q:D1=""  D
  1.  . S SCODE=$G(INSARRAY(9002313.48,D1,.01))
  1.  . S SUPRESSG(SCODE)=""
  1.  Q
  1. SETSUPRF ;SET UP SUPPRESS FIELD CODE ARRAY HERE.
  1.  N D1,SCODE
  1.  S D1=""
  1.  F  S D1=$O(INSARRAY(9002313.46,D1)) Q:D1=""  D
  1.  . S SCODE=$G(INSARRAY(9002313.46,D1,.01))
  1.  . S SUPRESF(SCODE)=""
  1.  Q