ABSPDB1E ; IHS/OIT/CASSevern/Pieran ran 1/19/2011 - Handling of outgoing NCPDP Billing "B1" Claims for D.0 (APPEND, FACILITY and NARRATIVE segments)
;;1.0;PHARMACY POINT OF SALE;**42**;JUN 21, 2001;Build 38
;These are the new segments added in D.0 that never existed before.
ADDDOC ;EP CALLED FROM ABSPDB1 to set up ADDITIONAL DOCUMENTATION SEGMENT
Q:$D(SUPRESSG("Additional Doc"))
N FIELD
S RECORD=$G(RECORD)
F FIELD="111",369,374,375,373,371,370,372,376,377,378,379,380,381,382,383 D
. Q:$D(SUPRESF(FIELD))
. I (ACTION["CLAIM"),(FIELD'=111) D
. . D @(FIELD_"GET")
. . D @(FIELD_"FMT")
. . D @(FIELD_"SET")
. ELSE D APPEND(FIELD)
Q
;Segment identifier
111GET S ABSP("X")=14
Q
111FMT S ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),2)
Q
111SET ;This isn't used for the 111 Field
Q
;Additioinal Documentation Type ID
369GET I '$D(SPECIAL(369)) S ABSP("X")=""
ELSE X SPECIAL(369)
Q
369FMT S:ABSP("X")'="" ABSP("X")="2Q"_$$ANFF^ABSPECFM($G(ABSP("X")),3)
Q
369SET ;Not Yet Implemented
Q
;Request Period Begin Date
374GET I '$D(SPECIAL(374)) S ABSP("X")=""
ELSE X SPECIAL(374)
Q
374FMT S:ABSP("X")'="" ABSP("X")="2V"_$$ANFF^ABSPECFM($G(ABSP("X")),8)
Q
374SET ;Not Yet Implemented
Q
;Request Period Recert/Revised Date
375GET I '$D(SPECIAL(375)) S ABSP("X")=""
ELSE X SPECIAL(375)
Q
375FMT S:ABSP("X")'="" ABSP("X")="2W"_$$ANFF^ABSPECFM($G(ABSP("X")),8)
Q
375SET ;Not Yet Implemented
Q
;Request Status
373GET I '$D(SPECIAL(373)) S ABSP("X")=""
ELSE X SPECIAL(373)
Q
373FMT S:ABSP("X")'="" ABSP("X")="2U"_$$ANFF^ABSPECFM($G(ABSP("X")),1)
Q
373SET ;Not Yet Implemented
Q
;Length of Need Qualifier
371GET I '$D(SPECIAL(371)) S ABSP("X")=""
ELSE X SPECIAL(371)
Q
371FMT S:ABSP("X")'="" ABSP("X")="2S"_$$ANFF^ABSPECFM($G(ABSP("X")),2)
Q
371SET ;Not Yet Implemented
Q
;Length of Need
370GET I '$D(SPECIAL(370)) S ABSP("X")=""
ELSE X SPECIAL(370)
Q
370FMT S:ABSP("X")'="" ABSP("X")="2R"_$$ANFF^ABSPECFM($G(ABSP("X")),3)
Q
370SET ;Not Yet Implemented
Q
;Prescriber/Supplier Date Signed
372GET I '$D(SPECIAL(372)) S ABSP("X")=""
ELSE X SPECIAL(372)
Q
372FMT S:ABSP("X")'="" ABSP("X")="2T"_$$ANFF^ABSPECFM($G(ABSP("X")),8)
Q
372SET ;Not Yet Implemented
Q
;Supporting Documentation
376GET I '$D(SPECIAL(376)) S ABSP("X")=""
ELSE X SPECIAL(376)
Q
376FMT S:ABSP("X")'="" ABSP("X")="2X"_$$ANFF^ABSPECFM($G(ABSP("X")),65)
Q
376SET ;Not Yet Implemented
Q
;Question Number/Letter Count
377GET I '$D(SPECIAL(377)) S ABSP("X")=""
ELSE X SPECIAL(377)
Q
377FMT S:ABSP("X")'="" ABSP("X")="2Z"_$$ANFF^ABSPECFM($G(ABSP("X")),2)
Q
377SET ;Not Yet Implemented
Q
;Question Number/Letter
378GET I '$D(SPECIAL(378)) S ABSP("X")=""
ELSE X SPECIAL(378)
Q
378FMT S:ABSP("X")'="" ABSP("X")="4B"_$$ANFF^ABSPECFM($G(ABSP("X")),3)
Q
378SET ;Not Yet Implemented
Q
;Question Percent Response
379GET I '$D(SPECIAL(379)) S ABSP("X")=""
ELSE X SPECIAL(379)
Q
379FMT S:ABSP("X")'="" ABSP("X")="4D"_$$ANFF^ABSPECFM($G(ABSP("X")),3)
Q
379SET ;Not Yet Implemented
Q
;Question Date Response
380GET I '$D(SPECIAL(380)) S ABSP("X")=""
ELSE X SPECIAL(380)
Q
380FMT S:ABSP("X")'="" ABSP("X")="4G"_$$ANFF^ABSPECFM($G(ABSP("X")),8)
Q
380SET ;Not Yet Implemented
Q
;Question Dollar Amount
381GET I '$D(SPECIAL(381)) S ABSP("X")=""
ELSE X SPECIAL(381)
Q
381FMT S:ABSP("X")'="" ABSP("X")="4H"_$$ANFF^ABSPECFM($G(ABSP("X")),9)
Q
381SET ;Not Yet Implemented
Q
;Question Numeric Response
382GET I '$D(SPECIAL(382)) S ABSP("X")=""
ELSE X SPECIAL(382)
Q
382FMT S:ABSP("X")'="" ABSP("X")="4J"_$$ANFF^ABSPECFM($G(ABSP("X")),11)
Q
382SET ;Not Yet Implemented
Q
;Question Alphanumeric Response
383GET I '$D(SPECIAL(383)) S ABSP("X")=""
ELSE X SPECIAL(383)
Q
383FMT S:ABSP("X")'="" ABSP("X")="4K"_$$ANFF^ABSPECFM($G(ABSP("X")),30)
Q
383SET ;Not Yet Implemented
Q
FACILITY ;EP CALLED FROM ABSPDB1 to set up FACILITY SEGMENT
Q:$D(SUPRESSG("Facility"))
N FIELD
S RECORD=$G(RECORD)
F FIELD="111A",336,385,386,388,387,389 D
. Q:$D(SUPRESF(FIELD))
. I (ACTION["CLAIM"),(FIELD'=111) D
. . D @(FIELD_"GET")
. . D @(FIELD_"FMT")
. . D @(FIELD_"SET")
. ELSE D APPEND(FIELD)
Q
;Segment identifier
111AGET S ABSP("X")=15
Q
111AFMT S ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),2)
Q
111ASET ;This isn't used for the 111 Field
Q
;Facility ID
336GET I '$D(SPECIAL(336)) S ABSP("X")=""
ELSE X SPECIAL(336)
Q
336FMT S:ABSP("X")'="" ABSP("X")="8C"_$$ANFF^ABSPECFM($G(ABSP("X")),10)
Q
336SET ;Not Yet Implemented
Q
;Facility Name
385GET I '$D(SPECIAL(385)) S ABSP("X")=""
ELSE X SPECIAL(385)
Q
385FMT S:ABSP("X")'="" ABSP("X")="3Q"_$$ANFF^ABSPECFM($G(ABSP("X")),30)
Q
385SET ;Not Yet Implemented
Q
;Facility Street Address
386GET I '$D(SPECIAL(386)) S ABSP("X")=""
ELSE X SPECIAL(386)
Q
386FMT S:ABSP("X")'="" ABSP("X")="3U"_$$ANFF^ABSPECFM($G(ABSP("X")),30)
Q
386SET ;Not Yet Implemented
Q
;Facility City Address
388GET I '$D(SPECIAL(388)) S ABSP("X")=""
ELSE X SPECIAL(388)
Q
388FMT S:ABSP("X")'="" ABSP("X")="5J"_$$ANFF^ABSPECFM($G(ABSP("X")),20)
Q
388SET S $P(^ABSPC(ABSP(9002313.02),388),U,1)=ABSP("X")
Q
;Facility State/Province Address
387GET I '$D(SPECIAL(387)) S ABSP("X")=""
ELSE X SPECIAL(387)
Q
387FMT S:ABSP("X")'="" ABSP("X")="3V"_$$ANFF^ABSPECFM($G(ABSP("X")),2)
Q
387SET ;Not Yet Implemented
Q
;Facility Zip
389GET I '$D(SPECIAL(389)) S ABSP("X")=""
ELSE X SPECIAL(389)
Q
389FMT S:ABSP("X")'="" ABSP("X")="6D"_$$ANFF^ABSPECFM($G(ABSP("X")),15)
Q
389SET ;Not Yet Implemented
Q
NARRATIVE ;EP CALLED FROM ABSPDB1 to set up NARRATIVE SEGMENT
Q:$D(SUPRESSG("Narrative"))
N FIELD
S RECORD=$G(RECORD)
F FIELD="111B",390 D
. Q:$D(SUPRESF(FIELD))
. I (ACTION["CLAIM"),(FIELD'=111) D
. . D @(FIELD_"GET")
. . D @(FIELD_"FMT")
. . D @(FIELD_"SET")
. ELSE D APPEND(FIELD)
Q
;Segment identifier
111BGET S ABSP("X")=16
Q
111BFMT S ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),2)
Q
111BSET ;This isn't used for the 111 Field
Q
;Narrative Message
390GET I '$D(SPECIAL(390)) S ABSP("X")=""
ELSE X SPECIAL(390)
Q
390FMT S:ABSP("X")'="" ABSP("X")="BM"_$$ANFF^ABSPECFM($G(ABSP("X")),200)
Q
390SET S $P(^ABSPC(ABSP(9002313.02),390),U,1)=ABSP("X")
Q
APPEND(FIELD) ;This is where the record is built field by field
I FIELD["111" D
. D @(FIELD_"GET")
. D @(FIELD_"FMT")
. S RECORD=RECORD_$C(30,28)_"AM"_ABSP("X")
ELSE D
. I $G(ABSP(9002313.0201,IEN(9002313.01),FIELD,"I"))'="" S RECORD=RECORD_$C(28)_$G(ABSP(9002313.0201,IEN(9002313.01),FIELD,"I"))
. ELSE I $D(SPECIAL(FIELD)) D
. . X SPECIAL(FIELD)
. . D @(FIELD_"FMT")
. . S RECORD=RECORD_$C(28)_ABSP("X")
Q
ABSPDB1E ; IHS/OIT/CASSevern/Pieran ran 1/19/2011 - Handling of outgoing NCPDP Billing "B1" Claims for D.0 (APPEND, FACILITY and NARRATIVE segments)
+1 ;;1.0;PHARMACY POINT OF SALE;**42**;JUN 21, 2001;Build 38
+2 ;These are the new segments added in D.0 that never existed before.
ADDDOC ;EP CALLED FROM ABSPDB1 to set up ADDITIONAL DOCUMENTATION SEGMENT
+1 IF $DATA(SUPRESSG("Additional Doc"))
QUIT
+2 NEW FIELD
+3 SET RECORD=$GET(RECORD)
+4 FOR FIELD="111",369,374,375,373,371,370,372,376,377,378,379,380,381,382,383
Begin DoDot:1
+5 IF $DATA(SUPRESF(FIELD))
QUIT
+6 IF (ACTION["CLAIM")
IF (FIELD'=111)
Begin DoDot:2
+7 DO @(FIELD_"GET")
+8 DO @(FIELD_"FMT")
+9 DO @(FIELD_"SET")
End DoDot:2
+10 IF '$TEST
DO APPEND(FIELD)
End DoDot:1
+11 QUIT
+12 ;Segment identifier
111GET SET ABSP("X")=14
+1 QUIT
111FMT SET ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),2)
+1 QUIT
111SET ;This isn't used for the 111 Field
+1 QUIT
+2 ;Additioinal Documentation Type ID
369GET IF '$DATA(SPECIAL(369))
SET ABSP("X")=""
+1 IF '$TEST
XECUTE SPECIAL(369)
+2 QUIT
369FMT IF ABSP("X")'=""
SET ABSP("X")="2Q"_$$ANFF^ABSPECFM($GET(ABSP("X")),3)
+1 QUIT
369SET ;Not Yet Implemented
+1 QUIT
+2 ;Request Period Begin Date
374GET IF '$DATA(SPECIAL(374))
SET ABSP("X")=""
+1 IF '$TEST
XECUTE SPECIAL(374)
+2 QUIT
374FMT IF ABSP("X")'=""
SET ABSP("X")="2V"_$$ANFF^ABSPECFM($GET(ABSP("X")),8)
+1 QUIT
374SET ;Not Yet Implemented
+1 QUIT
+2 ;Request Period Recert/Revised Date
375GET IF '$DATA(SPECIAL(375))
SET ABSP("X")=""
+1 IF '$TEST
XECUTE SPECIAL(375)
+2 QUIT
375FMT IF ABSP("X")'=""
SET ABSP("X")="2W"_$$ANFF^ABSPECFM($GET(ABSP("X")),8)
+1 QUIT
375SET ;Not Yet Implemented
+1 QUIT
+2 ;Request Status
373GET IF '$DATA(SPECIAL(373))
SET ABSP("X")=""
+1 IF '$TEST
XECUTE SPECIAL(373)
+2 QUIT
373FMT IF ABSP("X")'=""
SET ABSP("X")="2U"_$$ANFF^ABSPECFM($GET(ABSP("X")),1)
+1 QUIT
373SET ;Not Yet Implemented
+1 QUIT
+2 ;Length of Need Qualifier
371GET IF '$DATA(SPECIAL(371))
SET ABSP("X")=""
+1 IF '$TEST
XECUTE SPECIAL(371)
+2 QUIT
371FMT IF ABSP("X")'=""
SET ABSP("X")="2S"_$$ANFF^ABSPECFM($GET(ABSP("X")),2)
+1 QUIT
371SET ;Not Yet Implemented
+1 QUIT
+2 ;Length of Need
370GET IF '$DATA(SPECIAL(370))
SET ABSP("X")=""
+1 IF '$TEST
XECUTE SPECIAL(370)
+2 QUIT
370FMT IF ABSP("X")'=""
SET ABSP("X")="2R"_$$ANFF^ABSPECFM($GET(ABSP("X")),3)
+1 QUIT
370SET ;Not Yet Implemented
+1 QUIT
+2 ;Prescriber/Supplier Date Signed
372GET IF '$DATA(SPECIAL(372))
SET ABSP("X")=""
+1 IF '$TEST
XECUTE SPECIAL(372)
+2 QUIT
372FMT IF ABSP("X")'=""
SET ABSP("X")="2T"_$$ANFF^ABSPECFM($GET(ABSP("X")),8)
+1 QUIT
372SET ;Not Yet Implemented
+1 QUIT
+2 ;Supporting Documentation
376GET IF '$DATA(SPECIAL(376))
SET ABSP("X")=""
+1 IF '$TEST
XECUTE SPECIAL(376)
+2 QUIT
376FMT IF ABSP("X")'=""
SET ABSP("X")="2X"_$$ANFF^ABSPECFM($GET(ABSP("X")),65)
+1 QUIT
376SET ;Not Yet Implemented
+1 QUIT
+2 ;Question Number/Letter Count
377GET IF '$DATA(SPECIAL(377))
SET ABSP("X")=""
+1 IF '$TEST
XECUTE SPECIAL(377)
+2 QUIT
377FMT IF ABSP("X")'=""
SET ABSP("X")="2Z"_$$ANFF^ABSPECFM($GET(ABSP("X")),2)
+1 QUIT
377SET ;Not Yet Implemented
+1 QUIT
+2 ;Question Number/Letter
378GET IF '$DATA(SPECIAL(378))
SET ABSP("X")=""
+1 IF '$TEST
XECUTE SPECIAL(378)
+2 QUIT
378FMT IF ABSP("X")'=""
SET ABSP("X")="4B"_$$ANFF^ABSPECFM($GET(ABSP("X")),3)
+1 QUIT
378SET ;Not Yet Implemented
+1 QUIT
+2 ;Question Percent Response
379GET IF '$DATA(SPECIAL(379))
SET ABSP("X")=""
+1 IF '$TEST
XECUTE SPECIAL(379)
+2 QUIT
379FMT IF ABSP("X")'=""
SET ABSP("X")="4D"_$$ANFF^ABSPECFM($GET(ABSP("X")),3)
+1 QUIT
379SET ;Not Yet Implemented
+1 QUIT
+2 ;Question Date Response
380GET IF '$DATA(SPECIAL(380))
SET ABSP("X")=""
+1 IF '$TEST
XECUTE SPECIAL(380)
+2 QUIT
380FMT IF ABSP("X")'=""
SET ABSP("X")="4G"_$$ANFF^ABSPECFM($GET(ABSP("X")),8)
+1 QUIT
380SET ;Not Yet Implemented
+1 QUIT
+2 ;Question Dollar Amount
381GET IF '$DATA(SPECIAL(381))
SET ABSP("X")=""
+1 IF '$TEST
XECUTE SPECIAL(381)
+2 QUIT
381FMT IF ABSP("X")'=""
SET ABSP("X")="4H"_$$ANFF^ABSPECFM($GET(ABSP("X")),9)
+1 QUIT
381SET ;Not Yet Implemented
+1 QUIT
+2 ;Question Numeric Response
382GET IF '$DATA(SPECIAL(382))
SET ABSP("X")=""
+1 IF '$TEST
XECUTE SPECIAL(382)
+2 QUIT
382FMT IF ABSP("X")'=""
SET ABSP("X")="4J"_$$ANFF^ABSPECFM($GET(ABSP("X")),11)
+1 QUIT
382SET ;Not Yet Implemented
+1 QUIT
+2 ;Question Alphanumeric Response
383GET IF '$DATA(SPECIAL(383))
SET ABSP("X")=""
+1 IF '$TEST
XECUTE SPECIAL(383)
+2 QUIT
383FMT IF ABSP("X")'=""
SET ABSP("X")="4K"_$$ANFF^ABSPECFM($GET(ABSP("X")),30)
+1 QUIT
383SET ;Not Yet Implemented
+1 QUIT
FACILITY ;EP CALLED FROM ABSPDB1 to set up FACILITY SEGMENT
+1 IF $DATA(SUPRESSG("Facility"))
QUIT
+2 NEW FIELD
+3 SET RECORD=$GET(RECORD)
+4 FOR FIELD="111A",336,385,386,388,387,389
Begin DoDot:1
+5 IF $DATA(SUPRESF(FIELD))
QUIT
+6 IF (ACTION["CLAIM")
IF (FIELD'=111)
Begin DoDot:2
+7 DO @(FIELD_"GET")
+8 DO @(FIELD_"FMT")
+9 DO @(FIELD_"SET")
End DoDot:2
+10 IF '$TEST
DO APPEND(FIELD)
End DoDot:1
+11 QUIT
+12 ;Segment identifier
111AGET SET ABSP("X")=15
+1 QUIT
111AFMT SET ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),2)
+1 QUIT
111ASET ;This isn't used for the 111 Field
+1 QUIT
+2 ;Facility ID
336GET IF '$DATA(SPECIAL(336))
SET ABSP("X")=""
+1 IF '$TEST
XECUTE SPECIAL(336)
+2 QUIT
336FMT IF ABSP("X")'=""
SET ABSP("X")="8C"_$$ANFF^ABSPECFM($GET(ABSP("X")),10)
+1 QUIT
336SET ;Not Yet Implemented
+1 QUIT
+2 ;Facility Name
385GET IF '$DATA(SPECIAL(385))
SET ABSP("X")=""
+1 IF '$TEST
XECUTE SPECIAL(385)
+2 QUIT
385FMT IF ABSP("X")'=""
SET ABSP("X")="3Q"_$$ANFF^ABSPECFM($GET(ABSP("X")),30)
+1 QUIT
385SET ;Not Yet Implemented
+1 QUIT
+2 ;Facility Street Address
386GET IF '$DATA(SPECIAL(386))
SET ABSP("X")=""
+1 IF '$TEST
XECUTE SPECIAL(386)
+2 QUIT
386FMT IF ABSP("X")'=""
SET ABSP("X")="3U"_$$ANFF^ABSPECFM($GET(ABSP("X")),30)
+1 QUIT
386SET ;Not Yet Implemented
+1 QUIT
+2 ;Facility City Address
388GET IF '$DATA(SPECIAL(388))
SET ABSP("X")=""
+1 IF '$TEST
XECUTE SPECIAL(388)
+2 QUIT
388FMT IF ABSP("X")'=""
SET ABSP("X")="5J"_$$ANFF^ABSPECFM($GET(ABSP("X")),20)
+1 QUIT
388SET SET $PIECE(^ABSPC(ABSP(9002313.02),388),U,1)=ABSP("X")
+1 QUIT
+2 ;Facility State/Province Address
387GET IF '$DATA(SPECIAL(387))
SET ABSP("X")=""
+1 IF '$TEST
XECUTE SPECIAL(387)
+2 QUIT
387FMT IF ABSP("X")'=""
SET ABSP("X")="3V"_$$ANFF^ABSPECFM($GET(ABSP("X")),2)
+1 QUIT
387SET ;Not Yet Implemented
+1 QUIT
+2 ;Facility Zip
389GET IF '$DATA(SPECIAL(389))
SET ABSP("X")=""
+1 IF '$TEST
XECUTE SPECIAL(389)
+2 QUIT
389FMT IF ABSP("X")'=""
SET ABSP("X")="6D"_$$ANFF^ABSPECFM($GET(ABSP("X")),15)
+1 QUIT
389SET ;Not Yet Implemented
+1 QUIT
NARRATIVE ;EP CALLED FROM ABSPDB1 to set up NARRATIVE SEGMENT
+1 IF $DATA(SUPRESSG("Narrative"))
QUIT
+2 NEW FIELD
+3 SET RECORD=$GET(RECORD)
+4 FOR FIELD="111B",390
Begin DoDot:1
+5 IF $DATA(SUPRESF(FIELD))
QUIT
+6 IF (ACTION["CLAIM")
IF (FIELD'=111)
Begin DoDot:2
+7 DO @(FIELD_"GET")
+8 DO @(FIELD_"FMT")
+9 DO @(FIELD_"SET")
End DoDot:2
+10 IF '$TEST
DO APPEND(FIELD)
End DoDot:1
+11 QUIT
+12 ;Segment identifier
111BGET SET ABSP("X")=16
+1 QUIT
111BFMT SET ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),2)
+1 QUIT
111BSET ;This isn't used for the 111 Field
+1 QUIT
+2 ;Narrative Message
390GET IF '$DATA(SPECIAL(390))
SET ABSP("X")=""
+1 IF '$TEST
XECUTE SPECIAL(390)
+2 QUIT
390FMT IF ABSP("X")'=""
SET ABSP("X")="BM"_$$ANFF^ABSPECFM($GET(ABSP("X")),200)
+1 QUIT
390SET SET $PIECE(^ABSPC(ABSP(9002313.02),390),U,1)=ABSP("X")
+1 QUIT
APPEND(FIELD) ;This is where the record is built field by field
+1 IF FIELD["111"
Begin DoDot:1
+2 DO @(FIELD_"GET")
+3 DO @(FIELD_"FMT")
+4 SET RECORD=RECORD_$CHAR(30,28)_"AM"_ABSP("X")
End DoDot:1
+5 IF '$TEST
Begin DoDot:1
+6 IF $GET(ABSP(9002313.0201,IEN(9002313.01),FIELD,"I"))'=""
SET RECORD=RECORD_$CHAR(28)_$GET(ABSP(9002313.0201,IEN(9002313.01),FIELD,"I"))
+7 IF '$TEST
IF $DATA(SPECIAL(FIELD))
Begin DoDot:2
+8 XECUTE SPECIAL(FIELD)
+9 DO @(FIELD_"FMT")
+10 SET RECORD=RECORD_$CHAR(28)_ABSP("X")
End DoDot:2
End DoDot:1
+11 QUIT
