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

ABSP5B2.m

Go to the documentation of this file.
  1. ABSP5B2 ; IHS/OIT/CASSevern/Pieran ran 1/19/2011 - Handling of NCPDP Reversal "B2" Claims for 5.1
  1. ;;1.0;PHARMACY POINT OF SALE;**42,43**;JUN 21, 2001;Build 38
  1. ;
  1. ;
  1. ; SO FAR THIS IS JUST A COPY OF ABSPB1 "BILLING" TRANSACTION....MOST OF BELOW CODE WILL BE REPLACED!!!
  1. ; This routine will replace the ABSPOSCF for 5.1, 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,SUPPRESS
  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.46)) D SETSUPR
  1. D CHECKOVER^ABSP5B1F(D0,.SPECIAL) ;Check for Manual Over-Rides for this Claim
  1. ;I $D(SPECIAL) D ADDSEG^ABSPB1F(.SPECIAL,.ADDSEG) ;Figure out based on Special fields which segments we need
  1. I (ACTION="CLAIMHD")!(ACTION="OUTHD") D
  1. . D HEADER ;Every time
  1. . D INSURANCE ;Every time;IHS/OIT/CASSevern/Pieran/RCS; Patch 43 - Add back in
  1. I (ACTION="CLAIMRST")!(ACTION="OUTRST") D
  1. . I +$G(IEN(9002313.01))=0 S IEN(9002313.01)=1
  1. . D CLAIM^ABSP5B2A ;Every time
  1. . ;D PRICING^ABSP5B2A ;Pretty much every time
  1. . I $D(ADDSEG("DURRPPS")) D DURRPPS^ABSP5B2A ;Very common...but for over-rides only
  1. Q
  1. ;Go through field by field and construct the Header
  1. ;The header is the one segment that is completely unchanged between version 5.1 and D.0
  1. ;The only difference is field 102 "VERSION" now says D0 instead of 51
  1. N FIELD
  1. F FIELD=101,102,103,104,109,202,201,401,110 D
  1. . Q:$D(SUPPRESS(FIELD))
  1. . I (ACTION["CLAIM"),(FIELD'=111) D
  1. . . D @(FIELD_"GET")
  1. . . D @(FIELD_"FMT")
  1. . . D @(FIELD_"SET")
  1. . ELSE D @(FIELD_"APD")
  1. Q
  1. ;BIN #
  1. 101GET I '$D(SPECIAL(101)) S ABSP("X")=$G(INSARRAY(9002313.4,DO,100.16))
  1. ELSE X SPECIAL(101)
  1. Q
  1. 101FMT S ABSP("X")=$$NFF^ABSPECFM(ABSP("X"),6)
  1. Q
  1. 101SET S $P(^ABSPC(ABSP(9002313.02),100),U,1)=ABSP("X")
  1. Q
  1. 101APD S RECORD=$G(ABSP(9002313.02,MEDN,FIELD,"I"))
  1. Q
  1. ;VERSION (5.1, D.0)
  1. 102GET S ABSP("X")=$TR($G(INSARRAY(9002313.4,DO,100.15)),".","")
  1. Q
  1. 102FMT S ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),2)
  1. Q
  1. 102SET S $P(^ABSPC(ABSP(9002313.02),100),U,2)=ABSP("X")
  1. Q
  1. 102APD S RECORD=RECORD_$G(ABSP(9002313.02,MEDN,FIELD,"I"))
  1. Q
  1. ;TRANSACTION CODE "B2" for Reversal
  1. 103GET S ABSP("X")="B2"
  1. Q
  1. 103FMT S ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),2)
  1. Q
  1. 103SET S $P(^ABSPC(ABSP(9002313.02),100),U,3)=ABSP("X")
  1. Q
  1. 103APD S RECORD=RECORD_"B2"
  1. Q
  1. ;PCN #
  1. 104GET I '$D(SPECIAL(104)) S ABSP("X")=$G(INSARRAY(9002313.4,DO,100.17))
  1. ELSE X SPECIAL(104)
  1. Q
  1. 104FMT S ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),10)
  1. Q
  1. 104SET S $P(^ABSPC(ABSP(9002313.02),100),U,4)=ABSP("X")
  1. Q
  1. 104APD S RECORD=RECORD_$G(ABSP(9002313.02,MEDN,FIELD,"I"))
  1. Q
  1. ;Transaction count
  1. 109GET I '$D(SPECIAL(109)) S ABSP("X")=1 ;IHS/OIT/CASSevern/Pieran/RCS; Patch 43 - Force to a '1'
  1. ELSE X SPECIAL(109)
  1. Q
  1. 109FMT S ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),1)
  1. Q
  1. 109SET S $P(^ABSPC(ABSP(9002313.02),100),U,9)=ABSP("X")
  1. Q
  1. 109APD S RECORD=RECORD_1 ;IHS/OIT/CASSevern/Pieran/RCS; Patch 43 - Force to '1'
  1. Q
  1. ;Service provider ID
  1. 202GET I '$D(SPECIAL(202)) S ABSP("X")=$G(ABSP("Header","Service Prov ID Qual"))
  1. ELSE X SPECIAL(202)
  1. Q
  1. 202FMT S ABSP("X")=$$ANFF^ABSPECFM($G(ABSP("X")),2)
  1. Q
  1. 202SET S $P(^ABSPC(ABSP(9002313.02),200),U,2)=ABSP("X")
  1. Q
  1. 202APD S RECORD=RECORD_$G(ABSP(9002313.02,MEDN,FIELD,"I"))
  1. Q
  1. ;Pharmacy number
  1. 201GET I '$D(SPECIAL(201)) S ABSP("X")=$G(ABSP("Site","Pharmacy #"))
  1. ELSE X SPECIAL(201)
  1. Q
  1. 201FMT S ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),15)
  1. Q
  1. 201SET S $P(^ABSPC(ABSP(9002313.02),200),U,1)=ABSP("X")
  1. Q
  1. 201APD S RECORD=RECORD_$G(ABSP(9002313.02,MEDN,FIELD,"I"))
  1. Q
  1. ;Fill Date
  1. 401GET I '$D(SPECIAL(401)) S ABSP("X")=$G(ABSP("RX","Date Filled"))
  1. ELSE X SPECIAL(401)
  1. Q
  1. 401FMT S ABSP("X")=$$NFF^ABSPECFM($$DTF1^ABSPECFM(ABSP("X")),8)
  1. Q
  1. 401SET S $P(^ABSPC(ABSP(9002313.02),401),U,1)=ABSP("X")
  1. Q
  1. 401APD S RECORD=RECORD_$G(ABSP(9002313.02,MEDN,FIELD,"I"))
  1. Q
  1. ;Vendor ID
  1. 110GET I '$D(SPECIAL(110)) S ABSP("X")=$G(ABSP("Software Vendor"))
  1. ELSE X SPECIAL(110)
  1. Q
  1. 110FMT S ABSP("X")=$$ANFF^ABSPECFM($G(ABSP("X")),10)
  1. Q
  1. 110SET S $P(^ABSPC(ABSP(9002313.02),100),U,10)=ABSP("X")
  1. Q
  1. 110APD S RECORD=RECORD_$G(ABSP(9002313.02,MEDN,FIELD,"I"))
  1. Q
  1. INSURANCE ;INSURANCE Segment
  1. N FIELD
  1. S RECORD=$G(RECORD)
  1. F FIELD="111",302,301,359 D
  1. . Q:$D(SUPPRESS(FIELD))
  1. . I (ACTION["CLAIM"),(FIELD'=111) D
  1. . . D @(FIELD_"GET")
  1. . . D @(FIELD_"FMT")
  1. . . D @(FIELD_"SET")
  1. . ELSE D APPEND(FIELD)
  1. Q
  1. ;Segment identifier
  1. 111GET S ABSP("X")="04"
  1. Q
  1. 111FMT S ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),2)
  1. Q
  1. 111SET ;This isn't used for the 111 Field
  1. Q
  1. ;Cardholder ID
  1. 302GET I '$D(SPECIAL(302)) S ABSP("X")=$G(ABSP("Insurer","Policy #"))
  1. ELSE X SPECIAL(302)
  1. Q
  1. 302FMT S:ABSP("X")'="" ABSP("X")="C2"_$$ANFF^ABSPECFM($G(ABSP("X")),20)
  1. Q
  1. 302SET S $P(^ABSPC(ABSP(9002313.02),300),U,2)=ABSP("X")
  1. Q
  1. ;Group ID
  1. 301GET I '$D(SPECIAL(301)) S ABSP("X")=$G(ABSP("Insurer","Group #"))
  1. ELSE X SPECIAL(301)
  1. Q
  1. 301FMT S:ABSP("X")'="" ABSP("X")="C1"_$$ANFF^ABSPECFM(ABSP("X"),15)
  1. Q
  1. 301SET S $P(^ABSPC(ABSP(9002313.02),300),U,1)=ABSP("X")
  1. Q
  1. ;Medigap ID
  1. 359GET I '$D(SPECIAL(359)) S ABSP("X")=""
  1. ELSE X SPECIAL(359)
  1. Q
  1. 359FMT S:ABSP("X")'="" ABSP("X")="2A"_$$ANFF^ABSPECFM($G(ABSP("X")),20)
  1. Q
  1. 359SET ;Not Yet 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. . I MUMPS'["ABSP(""X"")" S MUMPS="S ABSP(""X"")="""_MUMPS_""""
  1. . S SPECIAL(NCODE)=MUMPS
  1. Q
  1. SETSUPR ;SET UP SUPPRESS 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 SUPPRESS(SCODE)=""
  1. Q
  1. APPEND(FIELD) ;This is where outgoing record is built field by field
  1. I FIELD["111" D
  1. . D @(FIELD_"GET")
  1. . D @(FIELD_"FMT")
  1. . S RECORD=RECORD_$C(30,28)_"AM"_ABSP("X")
  1. ELSE D
  1. . I $G(ABSP(9002313.02,MEDN,FIELD,"I"))'="" S RECORD=RECORD_$C(28)_$G(ABSP(9002313.02,MEDN,FIELD,"I"))
  1. . ELSE I $D(SPECIAL(FIELD)) D
  1. . . X SPECIAL(FIELD)
  1. . . D @(FIELD_"FMT")
  1. . . S RECORD=RECORD_$C(28)_ABSP("X")
  1. Q