Routine: ABSP5B1E

ABSP5B1E ; IHS/OIT/CASSevern/Pieran ran 1/19/2011 - Handling of outgoing NCPDP Billing "B1" Claims for 5.1 (Prior Authorization segment)

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

PRIORAUTH ;EP CALLED FROM ABSP5B1 to set up Prior Authorization Segment

 Q:$D(SUPRESSG("Prior Auth"))

 N FIELD,NFIELD

 S RECORD=$G(RECORD)

 F FIELD="111",498.01,498.02,498.03,498.04,498.05,498.06,498.07,498.08,498.09,498.11,498.13,498.14,503 D

 . Q:$D(SUPRESF(FIELD))

 . S NFIELD=$TR(FIELD,".","")

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

 . . D @(NFIELD_"GET")

 . . D @(NFIELD_"FMT")

 . . D @(NFIELD_"SET")

 . ELSE  D APPEND(FIELD,NFIELD)

 ;Segment identifier

111GET S ABSP("X")=12

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

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

 ;Add Prior Auth field GET,SET, FMT Code here:

 ;Request Type

49801GET I '$D(SPECIAL(498.01)) S ABSP("X")=$G(ABSP("Prior Auth",ABSP(9002313.0201),"Request Type"))

 ELSE  X SPECIAL(498.01)

49801FMT S ABSP("X")="PA"_$$ANFF^ABSPECFM(ABSP("X"),1)

49801SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),498),U,1)=ABSP("X")

 ;Request Period Date Begin

49802GET I '$D(SPECIAL(498.02)) S ABSP("X")=$G(ABSP("Prior Auth",ABSP(9002313.0201),"Req Per Date Begin"))

 ELSE  X SPECIAL(498.02)

49802FMT S ABSP("X")="PB"_$$NFF^ABSPECFM(ABSP("X"),8)

49802SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),498),U,2)=ABSP("X")

 ;Request Period Date End

49803GET I '$D(SPECIAL(498.03)) S ABSP("X")=$G(ABSP("Prior Auth",ABSP(9002313.0201),"Req Per Date End"))

 ELSE  X SPECIAL(498.03)

49803FMT S ABSP("X")="PC"_$$NFF^ABSPECFM(ABSP("X"),8)

49803SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),498),U,3)=ABSP("X")

 ;Basis of Request

49804GET I '$D(SPECIAL(498.04)) S ABSP("X")=$G(ABSP("Prior Auth",ABSP(9002313.0201),"Basis of Request"))

 ELSE  X SPECIAL(498.04)

49804FMT S ABSP("X")="PD"_$$ANFF^ABSPECFM(ABSP("X"),2)

49804SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),498),U,4)=ABSP("X")

 ;Authorized Rep First Name

49805GET I '$D(SPECIAL(498.05)) S ABSP("X")=$G(ABSP("Prior Auth",ABSP(9002313.0201),"Auth Rep Frst Nm"))

 ELSE  X SPECIAL(498.05)

49805FMT S ABSP("X")="PE"_$$ANFF^ABSPECFM(ABSP("X"),12)

49805SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),498),U,5)=ABSP("X")

 ;Authorized Rep Last Name

49806GET I '$D(SPECIAL(498.06)) S ABSP("X")=$G(ABSP("Prior Auth",ABSP(9002313.0201),"Auth Rep Last Nm"))

 ELSE  X SPECIAL(498.06)

49806FMT S ABSP("X")="PF"_$$ANFF^ABSPECFM(ABSP("X"),15)

49806SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),498),U,6)=ABSP("X")

 ;Authorized Rep Street Address

49807GET I '$D(SPECIAL(498.07)) S ABSP("X")=$G(ABSP("Prior Auth",ABSP(9002313.0201),"Auth Rep Street"))

 ELSE  X SPECIAL(498.07)

49807FMT S ABSP("X")="PG"_$$ANFF^ABSPECFM(ABSP("X"),30)

49807SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),498),U,7)=ABSP("X")

 ;Authorized Rep City Address

49808GET I '$D(SPECIAL(498.08)) S ABSP("X")=$G(ABSP("Prior Auth",ABSP(9002313.0201),"Auth Rep City"))

 ELSE  X SPECIAL(498.08)

49808FMT S ABSP("X")="PH"_$$ANFF^ABSPECFM(ABSP("X"),20)

49808SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),498),U,8)=ABSP("X")

 ;Authorized Rep State/Prov

49809GET I '$D(SPECIAL(498.09)) S ABSP("X")=$G(ABSP("Prior Auth",ABSP(9002313.0201),"Auth Rep State"))

 ELSE  X SPECIAL(498.09)

49809FMT S ABSP("X")="PJ"_$$ANFF^ABSPECFM(ABSP("X"),2)

49809SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),498),U,9)=ABSP("X")

 ;Authorized Rep Zip/Postal Zone

49811GET I '$D(SPECIAL(498.11)) S ABSP("X")=$G(ABSP("Prior Auth",ABSP(9002313.0201),"Auth Rep Zip"))

 ELSE  X SPECIAL(498.11)

49811FMT S ABSP("X")="PK"_$$ANFF^ABSPECFM(ABSP("X"),15)

49811SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),498),U,11)=ABSP("X")

 ;Prior Auth Supporting Doc  NOT IMPLEMENTED YET

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

 ELSE  X SPECIAL(498.13)

49813FMT S ABSP("X")="PP"_$$ANFF^ABSPECFM(ABSP("X"),80)

49813SET ;Not implemented yet

 ;Prior Auth Number Assigned

49814GET I '$D(SPECIAL(498.14)) S ABSP("X")=$G(ABSP("Prior Auth",ABSP(9002313.0201),"Number Assigned"))

 ELSE  X SPECIAL(498.14)

49814FMT S ABSP("X")="PY"_$$NFF^ABSPECFM(ABSP("X"),11)

49814SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),498),U,14)=ABSP("X")

 ;Authorization Number

503GET I '$D(SPECIAL(503)) S ABSP("X")=$G(ABSP("Prior Auth","Authorization Number"))

 ELSE  X SPECIAL(503)

503FMT S ABSP("X")="F3"_$$ANFF^ABSPECFM(ABSP("X"),20)

503SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),500),U,3)=ABSP("X")

APPEND(FIELD,NFIELD) ;This is where the 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 @(NFIELD_"FMT")

 . . S RECORD=RECORD_$C(28)_ABSP("X")

ABSP5B1E  ; IHS/OIT/CASSevern/Pieran ran 1/19/2011 - Handling of outgoing NCPDP Billing "B1" Claims for 5.1 (Prior Authorization segment)

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

PRIORAUTH ;EP CALLED FROM ABSP5B1 to set up Prior Authorization Segment

 +1        IF $DATA(SUPRESSG("Prior Auth"))

               QUIT

 +2        NEW FIELD,NFIELD

 +3        SET RECORD=$GET(RECORD)

 +4        FOR FIELD="111",498.01,498.02,498.03,498.04,498.05,498.06,498.07,498.08,498.09,498.11,498.13,498.14,503

               Begin DoDot:1

 +5                IF $DATA(SUPRESF(FIELD))

                       QUIT

 +6                SET NFIELD=$TRANSLATE(FIELD,".","")

 +7                IF (ACTION["CLAIM")

                       IF (FIELD'=111)

                           Begin DoDot:2

 +8                            DO @(NFIELD_"GET")

 +9                            DO @(NFIELD_"FMT")

 +10                           DO @(NFIELD_"SET")

                           End DoDot:2

 +11              IF '$TEST

                       DO APPEND(FIELD,NFIELD)

               End DoDot:1

 +12       QUIT

 +13      ;Segment identifier

111GET     SET ABSP("X")=12

 +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       ;Add Prior Auth field GET,SET, FMT Code here:

 +3       ;Request Type

49801GET   IF '$DATA(SPECIAL(498.01))

               SET ABSP("X")=$GET(ABSP("Prior Auth",ABSP(9002313.0201),"Request Type"))

 +1       IF '$TEST

               XECUTE SPECIAL(498.01)

 +2        QUIT

49801FMT   SET ABSP("X")="PA"_$$ANFF^ABSPECFM(ABSP("X"),1)

 +1        QUIT

49801SET   SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),498),U,1)=ABSP("X")

 +1        QUIT

 +2       ;Request Period Date Begin

49802GET   IF '$DATA(SPECIAL(498.02))

               SET ABSP("X")=$GET(ABSP("Prior Auth",ABSP(9002313.0201),"Req Per Date Begin"))

 +1       IF '$TEST

               XECUTE SPECIAL(498.02)

 +2        QUIT

49802FMT   SET ABSP("X")="PB"_$$NFF^ABSPECFM(ABSP("X"),8)

 +1        QUIT

49802SET   SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),498),U,2)=ABSP("X")

 +1        QUIT

 +2       ;Request Period Date End

49803GET   IF '$DATA(SPECIAL(498.03))

               SET ABSP("X")=$GET(ABSP("Prior Auth",ABSP(9002313.0201),"Req Per Date End"))

 +1       IF '$TEST

               XECUTE SPECIAL(498.03)

 +2        QUIT

49803FMT   SET ABSP("X")="PC"_$$NFF^ABSPECFM(ABSP("X"),8)

 +1        QUIT

49803SET   SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),498),U,3)=ABSP("X")

 +1        QUIT

 +2       ;Basis of Request

49804GET   IF '$DATA(SPECIAL(498.04))

               SET ABSP("X")=$GET(ABSP("Prior Auth",ABSP(9002313.0201),"Basis of Request"))

 +1       IF '$TEST

               XECUTE SPECIAL(498.04)

 +2        QUIT

49804FMT   SET ABSP("X")="PD"_$$ANFF^ABSPECFM(ABSP("X"),2)

 +1        QUIT

49804SET   SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),498),U,4)=ABSP("X")

 +1        QUIT

 +2       ;Authorized Rep First Name

49805GET   IF '$DATA(SPECIAL(498.05))

               SET ABSP("X")=$GET(ABSP("Prior Auth",ABSP(9002313.0201),"Auth Rep Frst Nm"))

 +1       IF '$TEST

               XECUTE SPECIAL(498.05)

 +2        QUIT

49805FMT   SET ABSP("X")="PE"_$$ANFF^ABSPECFM(ABSP("X"),12)

 +1        QUIT

49805SET   SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),498),U,5)=ABSP("X")

 +1        QUIT

 +2       ;Authorized Rep Last Name

49806GET   IF '$DATA(SPECIAL(498.06))

               SET ABSP("X")=$GET(ABSP("Prior Auth",ABSP(9002313.0201),"Auth Rep Last Nm"))

 +1       IF '$TEST

               XECUTE SPECIAL(498.06)

 +2        QUIT

49806FMT   SET ABSP("X")="PF"_$$ANFF^ABSPECFM(ABSP("X"),15)

 +1        QUIT

49806SET   SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),498),U,6)=ABSP("X")

 +1        QUIT

 +2       ;Authorized Rep Street Address

49807GET   IF '$DATA(SPECIAL(498.07))

               SET ABSP("X")=$GET(ABSP("Prior Auth",ABSP(9002313.0201),"Auth Rep Street"))

 +1       IF '$TEST

               XECUTE SPECIAL(498.07)

 +2        QUIT

49807FMT   SET ABSP("X")="PG"_$$ANFF^ABSPECFM(ABSP("X"),30)

 +1        QUIT

49807SET   SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),498),U,7)=ABSP("X")

 +1        QUIT

 +2       ;Authorized Rep City Address

49808GET   IF '$DATA(SPECIAL(498.08))

               SET ABSP("X")=$GET(ABSP("Prior Auth",ABSP(9002313.0201),"Auth Rep City"))

 +1       IF '$TEST

               XECUTE SPECIAL(498.08)

 +2        QUIT

49808FMT   SET ABSP("X")="PH"_$$ANFF^ABSPECFM(ABSP("X"),20)

 +1        QUIT

49808SET   SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),498),U,8)=ABSP("X")

 +1        QUIT

 +2       ;Authorized Rep State/Prov

49809GET   IF '$DATA(SPECIAL(498.09))

               SET ABSP("X")=$GET(ABSP("Prior Auth",ABSP(9002313.0201),"Auth Rep State"))

 +1       IF '$TEST

               XECUTE SPECIAL(498.09)

 +2        QUIT

49809FMT   SET ABSP("X")="PJ"_$$ANFF^ABSPECFM(ABSP("X"),2)

 +1        QUIT

49809SET   SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),498),U,9)=ABSP("X")

 +1        QUIT

 +2       ;Authorized Rep Zip/Postal Zone

49811GET   IF '$DATA(SPECIAL(498.11))

               SET ABSP("X")=$GET(ABSP("Prior Auth",ABSP(9002313.0201),"Auth Rep Zip"))

 +1       IF '$TEST

               XECUTE SPECIAL(498.11)

 +2        QUIT

49811FMT   SET ABSP("X")="PK"_$$ANFF^ABSPECFM(ABSP("X"),15)

 +1        QUIT

49811SET   SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),498),U,11)=ABSP("X")

 +1        QUIT

 +2       ;Prior Auth Supporting Doc  NOT IMPLEMENTED YET

49813GET   IF '$DATA(SPECIAL(498.13))

               SET ABSP("X")=""

 +1       IF '$TEST

               XECUTE SPECIAL(498.13)

 +2        QUIT

49813FMT   SET ABSP("X")="PP"_$$ANFF^ABSPECFM(ABSP("X"),80)

 +1        QUIT

49813SET  ;Not implemented yet

 +1        QUIT

 +2       ;Prior Auth Number Assigned

49814GET   IF '$DATA(SPECIAL(498.14))

               SET ABSP("X")=$GET(ABSP("Prior Auth",ABSP(9002313.0201),"Number Assigned"))

 +1       IF '$TEST

               XECUTE SPECIAL(498.14)

 +2        QUIT

49814FMT   SET ABSP("X")="PY"_$$NFF^ABSPECFM(ABSP("X"),11)

 +1        QUIT

49814SET   SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),498),U,14)=ABSP("X")

 +1        QUIT

 +2       ;Authorization Number

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

               SET ABSP("X")=$GET(ABSP("Prior Auth","Authorization Number"))

 +1       IF '$TEST

               XECUTE SPECIAL(503)

 +2        QUIT

503FMT     SET ABSP("X")="F3"_$$ANFF^ABSPECFM(ABSP("X"),20)

 +1        QUIT

503SET     SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),500),U,3)=ABSP("X")

 +1        QUIT

APPEND(FIELD,NFIELD) ;This is where the 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 @(NFIELD_"FMT")

 +10                           SET RECORD=RECORD_$CHAR(28)_ABSP("X")

                           End DoDot:2

               End DoDot:1

 +11       QUIT

ABSP5B1E.m