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)
Q
;Segment identifier
111GET S ABSP("X")=12
Q
111FMT S ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),2)
Q
111SET ;This isn't used for the 111 Field
Q
;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)
Q
49801FMT S ABSP("X")="PA"_$$ANFF^ABSPECFM(ABSP("X"),1)
Q
49801SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),498),U,1)=ABSP("X")
Q
;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)
Q
49802FMT S ABSP("X")="PB"_$$NFF^ABSPECFM(ABSP("X"),8)
Q
49802SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),498),U,2)=ABSP("X")
Q
;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)
Q
49803FMT S ABSP("X")="PC"_$$NFF^ABSPECFM(ABSP("X"),8)
Q
49803SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),498),U,3)=ABSP("X")
Q
;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)
Q
49804FMT S ABSP("X")="PD"_$$ANFF^ABSPECFM(ABSP("X"),2)
Q
49804SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),498),U,4)=ABSP("X")
Q
;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)
Q
49805FMT S ABSP("X")="PE"_$$ANFF^ABSPECFM(ABSP("X"),12)
Q
49805SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),498),U,5)=ABSP("X")
Q
;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)
Q
49806FMT S ABSP("X")="PF"_$$ANFF^ABSPECFM(ABSP("X"),15)
Q
49806SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),498),U,6)=ABSP("X")
Q
;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)
Q
49807FMT S ABSP("X")="PG"_$$ANFF^ABSPECFM(ABSP("X"),30)
Q
49807SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),498),U,7)=ABSP("X")
Q
;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)
Q
49808FMT S ABSP("X")="PH"_$$ANFF^ABSPECFM(ABSP("X"),20)
Q
49808SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),498),U,8)=ABSP("X")
Q
;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)
Q
49809FMT S ABSP("X")="PJ"_$$ANFF^ABSPECFM(ABSP("X"),2)
Q
49809SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),498),U,9)=ABSP("X")
Q
;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)
Q
49811FMT S ABSP("X")="PK"_$$ANFF^ABSPECFM(ABSP("X"),15)
Q
49811SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),498),U,11)=ABSP("X")
Q
;Prior Auth Supporting Doc NOT IMPLEMENTED YET
49813GET I '$D(SPECIAL(498.13)) S ABSP("X")=""
ELSE X SPECIAL(498.13)
Q
49813FMT S ABSP("X")="PP"_$$ANFF^ABSPECFM(ABSP("X"),80)
Q
49813SET ;Not implemented yet
Q
;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)
Q
49814FMT S ABSP("X")="PY"_$$NFF^ABSPECFM(ABSP("X"),11)
Q
49814SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),498),U,14)=ABSP("X")
Q
;Authorization Number
503GET I '$D(SPECIAL(503)) S ABSP("X")=$G(ABSP("Prior Auth","Authorization Number"))
ELSE X SPECIAL(503)
Q
503FMT S ABSP("X")="F3"_$$ANFF^ABSPECFM(ABSP("X"),20)
Q
503SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),500),U,3)=ABSP("X")
Q
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")
Q
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
