Routine: ABSP5B1C

ABSP5B1C ; IHS/OIT/CASSevern/Pieran ran 1/19/2011 - Handling of outgoing NCPDP Billing "B1" Claims for 5.1 (COB and WORKERS COMP Segments)

 ;;1.0;PHARMACY POINT OF SALE;**42**;JUN 21, 2001;Build 38

COB ;EP CALLED FROM ABSP5B1 to set up PRICING SEGMENT -- Segment not yet implemented We'll probably have to do something very similar to DURR and CLINIC segments

 Q:$D(SUPRESSG("COB"))

 N FIELD

 S RECORD=$G(RECORD)

 F FIELD="111",337,338,339,340,443,993,341,342,431,471,472 D

 . Q:$D(SUPRESF(FIELD))

 . I (ACTION["CLAIM"),(FIELD'=111) D

 . . D @(FIELD_"GET")

 . . D @(FIELD_"FMT")

 . . D @(FIELD_"SET")

 . ELSE  D APPEND(FIELD)

 ;Segment identifier

111GET S ABSP("X")="05"

111FMT S ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),2)

111SET ;This isn't used for the 111 Field

 ;Other Payments Count

337GET I '$D(SPECIAL(337)) S ABSP("X")=""

 ELSE  X SPECIAL(337)

337FMT S:ABSP("X")'="" ABSP("X")="4C"_$$NFF^ABSPECFM($G(ABSP("X")),2)

337SET ;Not Yet Implemented **

 ;Other Payer Coverage Type

338GET I '$D(SPECIAL(338)) S ABSP("X")=""

 ELSE  X SPECIAL(338)

338FMT S:ABSP("X")'="" ABSP("X")="5C"_$$ANFF^ABSPECFM($G(ABSP("X")),2)

338SET ;Not Yet Implemented **

 ;Other Payer ID Qualifer

339GET I '$D(SPECIAL(339)) S ABSP("X")=""

 ELSE  X SPECIAL(339)

339FMT S:ABSP("X")'="" ABSP("X")="6C"_$$ANFF^ABSPECFM($G(ABSP("X")),2)

339SET ;Not Yet Implemented **

 ;Other Payer ID

340GET I '$D(SPECIAL(340)) S ABSP("X")=""

 ELSE  X SPECIAL(340)

340FMT S:ABSP("X")'="" ABSP("X")="7C"_$$ANFF^ABSPECFM($G(ABSP("X")),10)

340SET ;Not Yet Implemented **

 ;Other Payer Date

443GET I '$D(SPECIAL(443)) S ABSP("X")=""

 ELSE  X SPECIAL(443)

443FMT S:ABSP("X")'="" ABSP("X")="E8"_$$ANFF^ABSPECFM($G(ABSP("X")),8)

443SET ;Not Yet Implemented **

 ;Internal Control Number

993GET I '$D(SPECIAL(993)) S ABSP("X")=""

 ELSE  X SPECIAL(993)

993FMT S:ABSP("X")'="" ABSP("X")="A7"_$$ANFF^ABSPECFM($G(ABSP("X")),30)

993SET ;Not Yet Implemented **

 ;Other Payer Amount Paid Count

341GET I '$D(SPECIAL(341)) S ABSP("X")=""

 ELSE  X SPECIAL(341)

341FMT S:ABSP("X")'="" ABSP("X")="HB"_$$ANFF^ABSPECFM($G(ABSP("X")),2)

341SET ;Not Yet Implemented **

 ;Other Payer Amount Paid Qualifier

342GET I '$D(SPECIAL(342)) S ABSP("X")=""

 ELSE  X SPECIAL(342)

342FMT S:ABSP("X")'="" ABSP("X")="HC"_$$ANFF^ABSPECFM($G(ABSP("X")),2)

342SET ;Not Yet Implemented **

 ;Other Payer Amount Paid

431GET I '$D(SPECIAL(431)) S ABSP("X")=""

 ELSE  X SPECIAL(431)

431FMT S:ABSP("X")'="" ABSP("X")="DV"_$$ANFF^ABSPECFM($G(ABSP("X")),6)

431SET ;Not Yet Implemented **

 ;Other Payer Reject Count

471GET I '$D(SPECIAL(471)) S ABSP("X")=""

 ELSE  X SPECIAL(471)

471FMT S:ABSP("X")'="" ABSP("X")="5E"_$$ANFF^ABSPECFM($G(ABSP("X")),2)

471SET ;Not Yet Implemented **

 ;Other Payer Reject Code

472GET I '$D(SPECIAL(472)) S ABSP("X")=""

 ELSE  X SPECIAL(472)

472FMT S:ABSP("X")'="" ABSP("X")="6E"_$$ANFF^ABSPECFM($G(ABSP("X")),3)

472SET ;Not Yet Implemented **

WORKCOMP ;EP CALLED FROM ABSP5B1 to set up WORKERS COMP SEGMENT -- Entire segment not implemented yet

 Q:$D(SUPRESSG("Workers Comp"))

 N FIELD

 S RECORD=$G(RECORD)

 F FIELD="111A",434,315,316,317,318,319,320,321,327,435 D

 . Q:$D(SUPRESF(FIELD))

 . I (ACTION["CLAIM"),(FIELD'=111) D

 . . D @(FIELD_"GET")

 . . D @(FIELD_"FMT")

 . . D @(FIELD_"SET")

 . ELSE  D APPEND(FIELD)

 ;Segment identifier

111AGET S ABSP("X")="06"

111AFMT S ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),2)

111ASET ;This isn't used for the 111 Field

 ;Date of Injury

434GET I '$D(SPECIAL(434)) S ABSP("X")=""

 ELSE  X SPECIAL(434)

434FMT S:ABSP("X")'="" ABSP("X")="DY"_$$ANFF^ABSPECFM($G(ABSP("X")),8)

434SET ;Not Yet Implemented

 ;Employer Name

315GET I '$D(SPECIAL(315)) S ABSP("X")=""

 ELSE  X SPECIAL(315)

315FMT S:ABSP("X")'="" ABSP("X")="CF"_$$ANFF^ABSPECFM($G(ABSP("X")),30)

315SET ;Not Yet Implemented

 ;Employer Street Address

316GET I '$D(SPECIAL(316)) S ABSP("X")=""

 ELSE  X SPECIAL(316)

316FMT S:ABSP("X")'="" ABSP("X")="CG"_$$ANFF^ABSPECFM($G(ABSP("X")),30)

316SET ;Not Yet Implemented

 ;Employer City Address

317GET I '$D(SPECIAL(317)) S ABSP("X")=""

 ELSE  X SPECIAL(317)

317FMT S:ABSP("X")'="" ABSP("X")="CH"_$$ANFF^ABSPECFM($G(ABSP("X")),20)

317SET ;Not Yet Implemented

 ;Employer State/Province Address

318GET I '$D(SPECIAL(318)) S ABSP("X")=""

 ELSE  X SPECIAL(318)

318FMT S:ABSP("X")'="" ABSP("X")="CI"_$$ANFF^ABSPECFM($G(ABSP("X")),2)

318SET ;Not Yet Implemented

 ;Employer Zip

319GET I '$D(SPECIAL(319)) S ABSP("X")=""

 ELSE  X SPECIAL(319)

319FMT S:ABSP("X")'="" ABSP("X")="CJ"_$$ANFF^ABSPECFM($G(ABSP("X")),15)

319SET ;Not Yet Implemented

 ;Employer Phone Number

320GET I '$D(SPECIAL(320)) S ABSP("X")=""

 ELSE  X SPECIAL(320)

320FMT S:ABSP("X")'="" ABSP("X")="CK"_$$ANFF^ABSPECFM($G(ABSP("X")),10)

320SET ;Not Yet Implemented

 ;Employer Contact Name

321GET I '$D(SPECIAL(321)) S ABSP("X")=""

 ELSE  X SPECIAL(321)

321FMT S:ABSP("X")'="" ABSP("X")="CL"_$$ANFF^ABSPECFM($G(ABSP("X")),30)

321SET ;Not Yet Implemented

 ;Carrier ID

327GET I '$D(SPECIAL(327)) S ABSP("X")=""

 ELSE  X SPECIAL(327)

327FMT S:ABSP("X")'="" ABSP("X")="CR"_$$ANFF^ABSPECFM($G(ABSP("X")),10)

327SET ;Not Yet Implemented

 ;Claim/Reference ID

435GET I '$D(SPECIAL(435)) S ABSP("X")=""

 ELSE  X SPECIAL(435)

435FMT S:ABSP("X")'="" ABSP("X")="DZ"_$$ANFF^ABSPECFM($G(ABSP("X")),30)

435SET ;Not Yet Implemented

APPEND(FIELD) ;This is where outgoing 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")

ABSP5B1C  ; IHS/OIT/CASSevern/Pieran ran 1/19/2011 - Handling of outgoing NCPDP Billing "B1" Claims for 5.1 (COB and WORKERS COMP Segments)

 +1       ;;1.0;PHARMACY POINT OF SALE;**42**;JUN 21, 2001;Build 38

COB       ;EP CALLED FROM ABSP5B1 to set up PRICING SEGMENT -- Segment not yet implemented We'll probably have to do something very similar to DURR and CLINIC segments

 +1        IF $DATA(SUPRESSG("COB"))

               QUIT

 +2        NEW FIELD

 +3        SET RECORD=$GET(RECORD)

 +4        FOR FIELD="111",337,338,339,340,443,993,341,342,431,471,472

               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")="05"

 +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       ;Other Payments Count

337GET     IF '$DATA(SPECIAL(337))

               SET ABSP("X")=""

 +1       IF '$TEST

               XECUTE SPECIAL(337)

 +2        QUIT

337FMT     IF ABSP("X")'=""

               SET ABSP("X")="4C"_$$NFF^ABSPECFM($GET(ABSP("X")),2)

 +1        QUIT

337SET    ;Not Yet Implemented **

 +1        QUIT

 +2       ;Other Payer Coverage Type

338GET     IF '$DATA(SPECIAL(338))

               SET ABSP("X")=""

 +1       IF '$TEST

               XECUTE SPECIAL(338)

 +2        QUIT

338FMT     IF ABSP("X")'=""

               SET ABSP("X")="5C"_$$ANFF^ABSPECFM($GET(ABSP("X")),2)

 +1        QUIT

338SET    ;Not Yet Implemented **

 +1        QUIT

 +2       ;Other Payer ID Qualifer

339GET     IF '$DATA(SPECIAL(339))

               SET ABSP("X")=""

 +1       IF '$TEST

               XECUTE SPECIAL(339)

 +2        QUIT

339FMT     IF ABSP("X")'=""

               SET ABSP("X")="6C"_$$ANFF^ABSPECFM($GET(ABSP("X")),2)

 +1        QUIT

339SET    ;Not Yet Implemented **

 +1        QUIT

 +2       ;Other Payer ID

340GET     IF '$DATA(SPECIAL(340))

               SET ABSP("X")=""

 +1       IF '$TEST

               XECUTE SPECIAL(340)

 +2        QUIT

340FMT     IF ABSP("X")'=""

               SET ABSP("X")="7C"_$$ANFF^ABSPECFM($GET(ABSP("X")),10)

 +1        QUIT

340SET    ;Not Yet Implemented **

 +1        QUIT

 +2       ;Other Payer Date

443GET     IF '$DATA(SPECIAL(443))

               SET ABSP("X")=""

 +1       IF '$TEST

               XECUTE SPECIAL(443)

 +2        QUIT

443FMT     IF ABSP("X")'=""

               SET ABSP("X")="E8"_$$ANFF^ABSPECFM($GET(ABSP("X")),8)

 +1        QUIT

443SET    ;Not Yet Implemented **

 +1        QUIT

 +2       ;Internal Control Number

993GET     IF '$DATA(SPECIAL(993))

               SET ABSP("X")=""

 +1       IF '$TEST

               XECUTE SPECIAL(993)

 +2        QUIT

993FMT     IF ABSP("X")'=""

               SET ABSP("X")="A7"_$$ANFF^ABSPECFM($GET(ABSP("X")),30)

 +1        QUIT

993SET    ;Not Yet Implemented **

 +1        QUIT

 +2       ;Other Payer Amount Paid Count

341GET     IF '$DATA(SPECIAL(341))

               SET ABSP("X")=""

 +1       IF '$TEST

               XECUTE SPECIAL(341)

 +2        QUIT

341FMT     IF ABSP("X")'=""

               SET ABSP("X")="HB"_$$ANFF^ABSPECFM($GET(ABSP("X")),2)

 +1        QUIT

341SET    ;Not Yet Implemented **

 +1        QUIT

 +2       ;Other Payer Amount Paid Qualifier

342GET     IF '$DATA(SPECIAL(342))

               SET ABSP("X")=""

 +1       IF '$TEST

               XECUTE SPECIAL(342)

 +2        QUIT

342FMT     IF ABSP("X")'=""

               SET ABSP("X")="HC"_$$ANFF^ABSPECFM($GET(ABSP("X")),2)

 +1        QUIT

342SET    ;Not Yet Implemented **

 +1        QUIT

 +2       ;Other Payer Amount Paid

431GET     IF '$DATA(SPECIAL(431))

               SET ABSP("X")=""

 +1       IF '$TEST

               XECUTE SPECIAL(431)

 +2        QUIT

431FMT     IF ABSP("X")'=""

               SET ABSP("X")="DV"_$$ANFF^ABSPECFM($GET(ABSP("X")),6)

 +1        QUIT

431SET    ;Not Yet Implemented **

 +1        QUIT

 +2       ;Other Payer Reject Count

471GET     IF '$DATA(SPECIAL(471))

               SET ABSP("X")=""

 +1       IF '$TEST

               XECUTE SPECIAL(471)

 +2        QUIT

471FMT     IF ABSP("X")'=""

               SET ABSP("X")="5E"_$$ANFF^ABSPECFM($GET(ABSP("X")),2)

 +1        QUIT

471SET    ;Not Yet Implemented **

 +1        QUIT

 +2       ;Other Payer Reject Code

472GET     IF '$DATA(SPECIAL(472))

               SET ABSP("X")=""

 +1       IF '$TEST

               XECUTE SPECIAL(472)

 +2        QUIT

472FMT     IF ABSP("X")'=""

               SET ABSP("X")="6E"_$$ANFF^ABSPECFM($GET(ABSP("X")),3)

 +1        QUIT

472SET    ;Not Yet Implemented **

 +1        QUIT

WORKCOMP  ;EP CALLED FROM ABSP5B1 to set up WORKERS COMP SEGMENT -- Entire segment not implemented yet

 +1        IF $DATA(SUPRESSG("Workers Comp"))

               QUIT

 +2        NEW FIELD

 +3        SET RECORD=$GET(RECORD)

 +4        FOR FIELD="111A",434,315,316,317,318,319,320,321,327,435

               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")="06"

 +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       ;Date of Injury

434GET     IF '$DATA(SPECIAL(434))

               SET ABSP("X")=""

 +1       IF '$TEST

               XECUTE SPECIAL(434)

 +2        QUIT

434FMT     IF ABSP("X")'=""

               SET ABSP("X")="DY"_$$ANFF^ABSPECFM($GET(ABSP("X")),8)

 +1        QUIT

434SET    ;Not Yet Implemented

 +1        QUIT

 +2       ;Employer Name

315GET     IF '$DATA(SPECIAL(315))

               SET ABSP("X")=""

 +1       IF '$TEST

               XECUTE SPECIAL(315)

 +2        QUIT

315FMT     IF ABSP("X")'=""

               SET ABSP("X")="CF"_$$ANFF^ABSPECFM($GET(ABSP("X")),30)

 +1        QUIT

315SET    ;Not Yet Implemented

 +1        QUIT

 +2       ;Employer Street Address

316GET     IF '$DATA(SPECIAL(316))

               SET ABSP("X")=""

 +1       IF '$TEST

               XECUTE SPECIAL(316)

 +2        QUIT

316FMT     IF ABSP("X")'=""

               SET ABSP("X")="CG"_$$ANFF^ABSPECFM($GET(ABSP("X")),30)

 +1        QUIT

316SET    ;Not Yet Implemented

 +1        QUIT

 +2       ;Employer City Address

317GET     IF '$DATA(SPECIAL(317))

               SET ABSP("X")=""

 +1       IF '$TEST

               XECUTE SPECIAL(317)

 +2        QUIT

317FMT     IF ABSP("X")'=""

               SET ABSP("X")="CH"_$$ANFF^ABSPECFM($GET(ABSP("X")),20)

 +1        QUIT

317SET    ;Not Yet Implemented

 +1        QUIT

 +2       ;Employer State/Province Address

318GET     IF '$DATA(SPECIAL(318))

               SET ABSP("X")=""

 +1       IF '$TEST

               XECUTE SPECIAL(318)

 +2        QUIT

318FMT     IF ABSP("X")'=""

               SET ABSP("X")="CI"_$$ANFF^ABSPECFM($GET(ABSP("X")),2)

 +1        QUIT

318SET    ;Not Yet Implemented

 +1        QUIT

 +2       ;Employer Zip

319GET     IF '$DATA(SPECIAL(319))

               SET ABSP("X")=""

 +1       IF '$TEST

               XECUTE SPECIAL(319)

 +2        QUIT

319FMT     IF ABSP("X")'=""

               SET ABSP("X")="CJ"_$$ANFF^ABSPECFM($GET(ABSP("X")),15)

 +1        QUIT

319SET    ;Not Yet Implemented

 +1        QUIT

 +2       ;Employer Phone Number

320GET     IF '$DATA(SPECIAL(320))

               SET ABSP("X")=""

 +1       IF '$TEST

               XECUTE SPECIAL(320)

 +2        QUIT

320FMT     IF ABSP("X")'=""

               SET ABSP("X")="CK"_$$ANFF^ABSPECFM($GET(ABSP("X")),10)

 +1        QUIT

320SET    ;Not Yet Implemented

 +1        QUIT

 +2       ;Employer Contact Name

321GET     IF '$DATA(SPECIAL(321))

               SET ABSP("X")=""

 +1       IF '$TEST

               XECUTE SPECIAL(321)

 +2        QUIT

321FMT     IF ABSP("X")'=""

               SET ABSP("X")="CL"_$$ANFF^ABSPECFM($GET(ABSP("X")),30)

 +1        QUIT

321SET    ;Not Yet Implemented

 +1        QUIT

 +2       ;Carrier ID

327GET     IF '$DATA(SPECIAL(327))

               SET ABSP("X")=""

 +1       IF '$TEST

               XECUTE SPECIAL(327)

 +2        QUIT

327FMT     IF ABSP("X")'=""

               SET ABSP("X")="CR"_$$ANFF^ABSPECFM($GET(ABSP("X")),10)

 +1        QUIT

327SET    ;Not Yet Implemented

 +1        QUIT

 +2       ;Claim/Reference ID

435GET     IF '$DATA(SPECIAL(435))

               SET ABSP("X")=""

 +1       IF '$TEST

               XECUTE SPECIAL(435)

 +2        QUIT

435FMT     IF ABSP("X")'=""

               SET ABSP("X")="DZ"_$$ANFF^ABSPECFM($GET(ABSP("X")),30)

 +1        QUIT

435SET    ;Not Yet Implemented

 +1        QUIT

APPEND(FIELD) ;This is where outgoing 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

ABSP5B1C.m