ABSPOSH7 ;IHS/SD/lwj - NCPDP 5.1 Post 5.1 response [ 09/04/2002 10:54 AM ]
;;1.0;PHARMACY POINT OF SALE;**3**;JUN 21, 2001;Build 38
;-------------------------------------------------------------
; Originally, the entire response was processed in the
; ABSPOSH5 routine - but it exceed SAC limitations on
; routine size - so the processing of some of the transaction
; level information was moved to this routine. Other portions
; were moved to the ABSPOSH6 routine.
;
; This routine is called solely from ABSPOSH5.
;
;
Q
RESPPRC ;EP - NCPDP 5.1 response processing (moved from ABSPOSH5)
; called from WRTTRAN^ABSPOSH5
; MEDN is set in ABSPOSH5 in the WRTTRAN subroutine
; process the response pricing segment - here's the fields we MIGHT
; encounter:
; 505 - patient pay amount
; 506 - ingredient code paid
; 507 - dispensing fee paid
; 557 - tax exempt indicator
; 558 - flat sales tax amount paid
; 559 - percentage sales tax amount paid
; 560 - percentage sales tax rate paid
; 561 - percentage sales tax basis paid
; 521 - incentive amount paid
; 562 - professional service fee paid
; 563 - other amount paid count
; 564 - other amount paid qualifier (repeating)
; 565 - other amount paid (repeating)
; 566 - other payer amount recognized
; 509 - total amount paid
; 522 - basis of reimbursement determination
; 523 - amount attributed to sales tax
; 512 - accumulated deductible amount
; 513 - remaining deductible amount
; 514 - remaining benefit amount
; 517 - amount applied to periodic deductible
; 518 - amount of copay/co-insurance
; 519 - amount attributed to product selection
; 520 - amount exceeding periodic benefit maximum
; 346 - basis of calculation - dispensing fee
; 347 - basis of calculation - copay
; 348 - basis of calculation - flat sales tax
; 349 - basis of calculation - percentage sales tax
;
; process everything up to the repeating fields
S $P(^ABSPR(RESPIEN,1000,INDEX,500),U,5)=$G(FDATA("M",MEDN,505))
S $P(^ABSPR(RESPIEN,1000,INDEX,500),U,6)=$G(FDATA("M",MEDN,506))
S $P(^ABSPR(RESPIEN,1000,INDEX,500),U,7)=$G(FDATA("M",MEDN,507))
S $P(^ABSPR(RESPIEN,1000,INDEX,550),U,7)=$G(FDATA("M",MEDN,557))
S $P(^ABSPR(RESPIEN,1000,INDEX,550),U,8)=$G(FDATA("M",MEDN,558))
S $P(^ABSPR(RESPIEN,1000,INDEX,550),U,9)=$G(FDATA("M",MEDN,559))
S $P(^ABSPR(RESPIEN,1000,INDEX,550),U,10)=$G(FDATA("M",MEDN,560))
S $P(^ABSPR(RESPIEN,1000,INDEX,560),U)=$G(FDATA("M",MEDN,561))
S $P(^ABSPR(RESPIEN,1000,INDEX,500),U,21)=$G(FDATA("M",MEDN,521))
S $P(^ABSPR(RESPIEN,1000,INDEX,560),U,2)=$G(FDATA("M",MEDN,562))
;
; figure out if we have any of the other paid amount repeating flds
S $P(^ABSPR(RESPIEN,1000,INDEX,560),U,3)=$G(FDATA("M",MEDN,563))
I $D(FDATA("M",MEDN,563)) D REPOPA ;process the repeating flds
;
; now back to the reqular fields
S $P(^ABSPR(RESPIEN,1000,INDEX,560),U,6)=$G(FDATA("M",MEDN,566))
S $P(^ABSPR(RESPIEN,1000,INDEX,500),U,9)=$G(FDATA("M",MEDN,509))
S $P(^ABSPR(RESPIEN,1000,INDEX,500),U,22)=$G(FDATA("M",MEDN,522))
S $P(^ABSPR(RESPIEN,1000,INDEX,500),U,23)=$G(FDATA("M",MEDN,523))
S $P(^ABSPR(RESPIEN,1000,INDEX,500),U,12)=$G(FDATA("M",MEDN,512))
S $P(^ABSPR(RESPIEN,1000,INDEX,500),U,13)=$G(FDATA("M",MEDN,513))
S $P(^ABSPR(RESPIEN,1000,INDEX,500),U,14)=$G(FDATA("M",MEDN,514))
S $P(^ABSPR(RESPIEN,1000,INDEX,500),U,17)=$G(FDATA("M",MEDN,517))
S $P(^ABSPR(RESPIEN,1000,INDEX,500),U,18)=$G(FDATA("M",MEDN,518))
S $P(^ABSPR(RESPIEN,1000,INDEX,500),U,19)=$G(FDATA("M",MEDN,519))
S $P(^ABSPR(RESPIEN,1000,INDEX,500),U,20)=$G(FDATA("M",MEDN,520))
S $P(^ABSPR(RESPIEN,1000,INDEX,340),U,6)=$G(FDATA("M",MEDN,346))
S $P(^ABSPR(RESPIEN,1000,INDEX,340),U,7)=$G(FDATA("M",MEDN,347))
S $P(^ABSPR(RESPIEN,1000,INDEX,340),U,8)=$G(FDATA("M",MEDN,348))
S $P(^ABSPR(RESPIEN,1000,INDEX,340),U,9)=$G(FDATA("M",MEDN,349))
;
;
Q
;
;
REPOPA ; This subroutine will process the other amount paid repeating fields
; that are a part of the pricing segment.
; Two fields here - 564 - other amount paid qualifier
; 565 - other amount paid
;
N CNTR,COUNT,AMTPDQ,AMTPD,CKREC
;
S RLCNT=0
S COUNT=$G(FDATA("M",MEDN,563)) ;other amoutn paid count
Q:COUNT'>0
;
F CNTR=1:1:COUNT D
. S (AMTPDQ,AMTPD)=""
. S AMTPDQ=$G(FDATA("M",MEDN,564,CNTR)) ;other amount paid qual
. S AMTPD=$G(FDATA("M",MEDN,565,CNTR)) ;other amount paid
. S CKREC=AMTPDQ_AMTPD ;quick chk for values
. I $D(CKREC) D
.. S $P(^ABSPR(RESPIEN,1000,INDEX,563.01,CNTR,0),U)=CNTR
.. S ^ABSPR(RESPIEN,1000,INDEX,563.01,"B",CNTR,CNTR)=""
.. S RLCNT=RLCNT+1
. S:$D(AMTPDQ) $P(^ABSPR(RESPIEN,1000,INDEX,563.01,CNTR,1),U,1)=AMTPDQ
. S:$D(AMTPD) $P(^ABSPR(RESPIEN,1000,INDEX,563.01,CNTR,1),U,2)=AMTPD
;
I RLCNT>0 D
. S ^ABSPR(RESPIEN,1000,INDEX,563.01,0)="^9002313.1401A^"_RLCNT_"^"_RLCNT
;
Q
;
RESPDUR ;EP - NCPDP 5.1 response processing (moved from ABSPOSH5)
; called from WRTTRAN^ABSPOSH5
; MEDN is set in ABSPOSH5 in the WRTTRAN subroutine
; process the response DUR segment - here's the fields we MIGHT
; encounter:
; 567 - DUR/PPS Response Code counter (repeating)
; 439 - reason for service (repeating)
; 528 - clinical significance code (repeating)
; 529 - other pharmacy indicator (repeating)
; 530 - previous date of fill (repeating)
; 531 - quanityt of previous fill (repeating)
; 532 - database indicator (repeating)
; 533 - other prescriber indicator (repeating)
; 544 - DUR free text message (repeating)
;
; All fields on this segment are not only optional, but also
; repeating. Please note that field 567 is NOT a count, but
; a counter, which changes how we process this repeating
; segment. Since this entire record is repeating, and the
; logic is different, we will keep it here, rather than have
; it call a separate repeating subroutine.
;
;
N CNTR,RLCNT,RSNCD,CLINCD,OTHPHM,PREVDT,PRVQTY,DBID,OTHPRS,FREETX
;
Q:'$D(FDATA("M",MEDN,567)) ;just quit if there isn't anything
;
S (CNTR,RLCNT)=0
;
F S CNTR=$O(FDATA("M",MEDN,567,CNTR)) Q:CNTR="" D
. ;first lets retrieve the values for this record
. S RLCNT=RLCNT+1
. S (RSNCD,CLINCD,OTHPHM,PREVDT,PRVQTY,DBID,OTHPRS,FREETX)=""
. S RSNCD=$G(FDATA("M",MEDN,439,CNTR)) ;reason for service code
. S CLINCD=$G(FDATA("M",MEDN,528,CNTR)) ;clinical significance code
. S OTHPHM=$G(FDATA("M",MEDN,529,CNTR)) ;other pharmacy indicator
. S PREVDT=$G(FDATA("M",MEDN,530,CNTR)) ;previous date of fill
. S PRVQTY=$G(FDATA("M",MEDN,531,CNTR)) ;quantity of previous fill
. S DBID=$G(FDATA("M",MEDN,532,CNTR)) ;database indicator
. S OTHPRS=$G(FDATA("M",MEDN,533,CNTR)) ;other prescriber indicator
. S FREETX=$G(FDATA("M",MEDN,544,CNTR)) ;DUR free text message
. ;
. ; now lets set the response file with the values we just got
. ; don't forget that we have to hard set the "b" xref too
. S $P(^ABSPR(RESPIEN,1000,INDEX,567.01,CNTR,0),U)=CNTR
. S ^ABSPR(RESPIEN,1000,INDEX,567.01,"B",CNTR,CNTR)=""
. S:$D(RSNCD) $P(^ABSPR(RESPIEN,1000,INDEX,567.01,CNTR,0),U,2)=RSNCD
. S:$D(CLINCD) $P(^ABSPR(RESPIEN,1000,INDEX,567.01,CNTR,0),U,3)=CLINCD
. S:$D(OTHPHM) $P(^ABSPR(RESPIEN,1000,INDEX,567.01,CNTR,0),U,4)=OTHPHM
. S:$D(PREVDT) $P(^ABSPR(RESPIEN,1000,INDEX,567.01,CNTR,0),U,5)=PREVDT
. S:$D(PRVQTY) $P(^ABSPR(RESPIEN,1000,INDEX,567.01,CNTR,0),U,6)=PRVQTY
. S:$D(DBID) $P(^ABSPR(RESPIEN,1000,INDEX,567.01,CNTR,0),U,7)=DBID
. S:$D(OTHPRS) $P(^ABSPR(RESPIEN,1000,INDEX,567.01,CNTR,0),U,8)=OTHPRS
. S:$D(FREETX) $P(^ABSPR(RESPIEN,1000,INDEX,567.01,CNTR,0),U,9)=FREETX
;
I RLCNT>0 D
. S ^ABSPR(RESPIEN,1000,INDEX,567.01,0)="^9002313.1101A^"_RLCNT_"^"_RLCNT
;
Q
;
;
RESPPA ;EP - NCPDP 5.1 response processing (moved from ABSPOSH5)
; called from WRTTRAN^ABSPOSH5
; MEDN is set in ABSPOSH5 in the WRTTRAN subroutine
; process the response prior authorization segment - here's the
; fields we MIGHT encounter:
; 498.51 - prior authorization processed date
; 498.52 - prior authorization effective date
; 498.53 - prior authorization expiration date
; 498.57 - prior authorization quantity
; 498.58 - prior authorization dollars authorized
; 498.54 - prior authorization number of refills authorized
; 498.55 - prior authorization quantity accumulated
; 498.14 - prior authorization number - assigned
;
; no repeating fields on this segments so we will simply process
; what we find
;
S $P(^ABSPR(RESPIEN,1000,INDEX,498),U,1)=$G(FDATA("M",MEDN,498.51))
S $P(^ABSPR(RESPIEN,1000,INDEX,498),U,2)=$G(FDATA("M",MEDN,498.52))
S $P(^ABSPR(RESPIEN,1000,INDEX,498),U,3)=$G(FDATA("M",MEDN,498.53))
S $P(^ABSPR(RESPIEN,1000,INDEX,498),U,7)=$G(FDATA("M",MEDN,498.57))
S $P(^ABSPR(RESPIEN,1000,INDEX,498),U,8)=$G(FDATA("M",MEDN,498.58))
S $P(^ABSPR(RESPIEN,1000,INDEX,498),U,4)=$G(FDATA("M",MEDN,498.54))
S $P(^ABSPR(RESPIEN,1000,INDEX,498),U,5)=$G(FDATA("M",MEDN,498.55))
S $P(^ABSPR(RESPIEN,1000,INDEX,498),U,6)=$G(FDATA("M",MEDN,498.14))
;
;
Q
;
ABSPOSH7 ;IHS/SD/lwj - NCPDP 5.1 Post 5.1 response [ 09/04/2002 10:54 AM ]
+1 ;;1.0;PHARMACY POINT OF SALE;**3**;JUN 21, 2001;Build 38
+2 ;-------------------------------------------------------------
+3 ; Originally, the entire response was processed in the
+4 ; ABSPOSH5 routine - but it exceed SAC limitations on
+5 ; routine size - so the processing of some of the transaction
+6 ; level information was moved to this routine. Other portions
+7 ; were moved to the ABSPOSH6 routine.
+8 ;
+9 ; This routine is called solely from ABSPOSH5.
+10 ;
+11 ;
+12 QUIT
RESPPRC ;EP - NCPDP 5.1 response processing (moved from ABSPOSH5)
+1 ; called from WRTTRAN^ABSPOSH5
+2 ; MEDN is set in ABSPOSH5 in the WRTTRAN subroutine
+3 ; process the response pricing segment - here's the fields we MIGHT
+4 ; encounter:
+5 ; 505 - patient pay amount
+6 ; 506 - ingredient code paid
+7 ; 507 - dispensing fee paid
+8 ; 557 - tax exempt indicator
+9 ; 558 - flat sales tax amount paid
+10 ; 559 - percentage sales tax amount paid
+11 ; 560 - percentage sales tax rate paid
+12 ; 561 - percentage sales tax basis paid
+13 ; 521 - incentive amount paid
+14 ; 562 - professional service fee paid
+15 ; 563 - other amount paid count
+16 ; 564 - other amount paid qualifier (repeating)
+17 ; 565 - other amount paid (repeating)
+18 ; 566 - other payer amount recognized
+19 ; 509 - total amount paid
+20 ; 522 - basis of reimbursement determination
+21 ; 523 - amount attributed to sales tax
+22 ; 512 - accumulated deductible amount
+23 ; 513 - remaining deductible amount
+24 ; 514 - remaining benefit amount
+25 ; 517 - amount applied to periodic deductible
+26 ; 518 - amount of copay/co-insurance
+27 ; 519 - amount attributed to product selection
+28 ; 520 - amount exceeding periodic benefit maximum
+29 ; 346 - basis of calculation - dispensing fee
+30 ; 347 - basis of calculation - copay
+31 ; 348 - basis of calculation - flat sales tax
+32 ; 349 - basis of calculation - percentage sales tax
+33 ;
+34 ; process everything up to the repeating fields
+35 SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,500),U,5)=$GET(FDATA("M",MEDN,505))
+36 SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,500),U,6)=$GET(FDATA("M",MEDN,506))
+37 SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,500),U,7)=$GET(FDATA("M",MEDN,507))
+38 SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,550),U,7)=$GET(FDATA("M",MEDN,557))
+39 SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,550),U,8)=$GET(FDATA("M",MEDN,558))
+40 SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,550),U,9)=$GET(FDATA("M",MEDN,559))
+41 SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,550),U,10)=$GET(FDATA("M",MEDN,560))
+42 SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,560),U)=$GET(FDATA("M",MEDN,561))
+43 SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,500),U,21)=$GET(FDATA("M",MEDN,521))
+44 SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,560),U,2)=$GET(FDATA("M",MEDN,562))
+45 ;
+46 ; figure out if we have any of the other paid amount repeating flds
+47 SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,560),U,3)=$GET(FDATA("M",MEDN,563))
+48 ;process the repeating flds
IF $DATA(FDATA("M",MEDN,563))
DO REPOPA
+49 ;
+50 ; now back to the reqular fields
+51 SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,560),U,6)=$GET(FDATA("M",MEDN,566))
+52 SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,500),U,9)=$GET(FDATA("M",MEDN,509))
+53 SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,500),U,22)=$GET(FDATA("M",MEDN,522))
+54 SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,500),U,23)=$GET(FDATA("M",MEDN,523))
+55 SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,500),U,12)=$GET(FDATA("M",MEDN,512))
+56 SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,500),U,13)=$GET(FDATA("M",MEDN,513))
+57 SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,500),U,14)=$GET(FDATA("M",MEDN,514))
+58 SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,500),U,17)=$GET(FDATA("M",MEDN,517))
+59 SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,500),U,18)=$GET(FDATA("M",MEDN,518))
+60 SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,500),U,19)=$GET(FDATA("M",MEDN,519))
+61 SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,500),U,20)=$GET(FDATA("M",MEDN,520))
+62 SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,340),U,6)=$GET(FDATA("M",MEDN,346))
+63 SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,340),U,7)=$GET(FDATA("M",MEDN,347))
+64 SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,340),U,8)=$GET(FDATA("M",MEDN,348))
+65 SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,340),U,9)=$GET(FDATA("M",MEDN,349))
+66 ;
+67 ;
+68 QUIT
+69 ;
+70 ;
REPOPA ; This subroutine will process the other amount paid repeating fields
+1 ; that are a part of the pricing segment.
+2 ; Two fields here - 564 - other amount paid qualifier
+3 ; 565 - other amount paid
+4 ;
+5 NEW CNTR,COUNT,AMTPDQ,AMTPD,CKREC
+6 ;
+7 SET RLCNT=0
+8 ;other amoutn paid count
SET COUNT=$GET(FDATA("M",MEDN,563))
+9 IF COUNT'>0
QUIT
+10 ;
+11 FOR CNTR=1:1:COUNT
Begin DoDot:1
+12 SET (AMTPDQ,AMTPD)=""
+13 ;other amount paid qual
SET AMTPDQ=$GET(FDATA("M",MEDN,564,CNTR))
+14 ;other amount paid
SET AMTPD=$GET(FDATA("M",MEDN,565,CNTR))
+15 ;quick chk for values
SET CKREC=AMTPDQ_AMTPD
+16 IF $DATA(CKREC)
Begin DoDot:2
+17 SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,563.01,CNTR,0),U)=CNTR
+18 SET ^ABSPR(RESPIEN,1000,INDEX,563.01,"B",CNTR,CNTR)=""
+19 SET RLCNT=RLCNT+1
End DoDot:2
+20 IF $DATA(AMTPDQ)
SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,563.01,CNTR,1),U,1)=AMTPDQ
+21 IF $DATA(AMTPD)
SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,563.01,CNTR,1),U,2)=AMTPD
End DoDot:1
+22 ;
+23 IF RLCNT>0
Begin DoDot:1
+24 SET ^ABSPR(RESPIEN,1000,INDEX,563.01,0)="^9002313.1401A^"_RLCNT_"^"_RLCNT
End DoDot:1
+25 ;
+26 QUIT
+27 ;
RESPDUR ;EP - NCPDP 5.1 response processing (moved from ABSPOSH5)
+1 ; called from WRTTRAN^ABSPOSH5
+2 ; MEDN is set in ABSPOSH5 in the WRTTRAN subroutine
+3 ; process the response DUR segment - here's the fields we MIGHT
+4 ; encounter:
+5 ; 567 - DUR/PPS Response Code counter (repeating)
+6 ; 439 - reason for service (repeating)
+7 ; 528 - clinical significance code (repeating)
+8 ; 529 - other pharmacy indicator (repeating)
+9 ; 530 - previous date of fill (repeating)
+10 ; 531 - quanityt of previous fill (repeating)
+11 ; 532 - database indicator (repeating)
+12 ; 533 - other prescriber indicator (repeating)
+13 ; 544 - DUR free text message (repeating)
+14 ;
+15 ; All fields on this segment are not only optional, but also
+16 ; repeating. Please note that field 567 is NOT a count, but
+17 ; a counter, which changes how we process this repeating
+18 ; segment. Since this entire record is repeating, and the
+19 ; logic is different, we will keep it here, rather than have
+20 ; it call a separate repeating subroutine.
+21 ;
+22 ;
+23 NEW CNTR,RLCNT,RSNCD,CLINCD,OTHPHM,PREVDT,PRVQTY,DBID,OTHPRS,FREETX
+24 ;
+25 ;just quit if there isn't anything
IF '$DATA(FDATA("M",MEDN,567))
QUIT
+26 ;
+27 SET (CNTR,RLCNT)=0
+28 ;
+29 FOR
SET CNTR=$ORDER(FDATA("M",MEDN,567,CNTR))
IF CNTR=""
QUIT
Begin DoDot:1
+30 ;first lets retrieve the values for this record
+31 SET RLCNT=RLCNT+1
+32 SET (RSNCD,CLINCD,OTHPHM,PREVDT,PRVQTY,DBID,OTHPRS,FREETX)=""
+33 ;reason for service code
SET RSNCD=$GET(FDATA("M",MEDN,439,CNTR))
+34 ;clinical significance code
SET CLINCD=$GET(FDATA("M",MEDN,528,CNTR))
+35 ;other pharmacy indicator
SET OTHPHM=$GET(FDATA("M",MEDN,529,CNTR))
+36 ;previous date of fill
SET PREVDT=$GET(FDATA("M",MEDN,530,CNTR))
+37 ;quantity of previous fill
SET PRVQTY=$GET(FDATA("M",MEDN,531,CNTR))
+38 ;database indicator
SET DBID=$GET(FDATA("M",MEDN,532,CNTR))
+39 ;other prescriber indicator
SET OTHPRS=$GET(FDATA("M",MEDN,533,CNTR))
+40 ;DUR free text message
SET FREETX=$GET(FDATA("M",MEDN,544,CNTR))
+41 ;
+42 ; now lets set the response file with the values we just got
+43 ; don't forget that we have to hard set the "b" xref too
+44 SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,567.01,CNTR,0),U)=CNTR
+45 SET ^ABSPR(RESPIEN,1000,INDEX,567.01,"B",CNTR,CNTR)=""
+46 IF $DATA(RSNCD)
SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,567.01,CNTR,0),U,2)=RSNCD
+47 IF $DATA(CLINCD)
SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,567.01,CNTR,0),U,3)=CLINCD
+48 IF $DATA(OTHPHM)
SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,567.01,CNTR,0),U,4)=OTHPHM
+49 IF $DATA(PREVDT)
SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,567.01,CNTR,0),U,5)=PREVDT
+50 IF $DATA(PRVQTY)
SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,567.01,CNTR,0),U,6)=PRVQTY
+51 IF $DATA(DBID)
SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,567.01,CNTR,0),U,7)=DBID
+52 IF $DATA(OTHPRS)
SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,567.01,CNTR,0),U,8)=OTHPRS
+53 IF $DATA(FREETX)
SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,567.01,CNTR,0),U,9)=FREETX
End DoDot:1
+54 ;
+55 IF RLCNT>0
Begin DoDot:1
+56 SET ^ABSPR(RESPIEN,1000,INDEX,567.01,0)="^9002313.1101A^"_RLCNT_"^"_RLCNT
End DoDot:1
+57 ;
+58 QUIT
+59 ;
+60 ;
RESPPA ;EP - NCPDP 5.1 response processing (moved from ABSPOSH5)
+1 ; called from WRTTRAN^ABSPOSH5
+2 ; MEDN is set in ABSPOSH5 in the WRTTRAN subroutine
+3 ; process the response prior authorization segment - here's the
+4 ; fields we MIGHT encounter:
+5 ; 498.51 - prior authorization processed date
+6 ; 498.52 - prior authorization effective date
+7 ; 498.53 - prior authorization expiration date
+8 ; 498.57 - prior authorization quantity
+9 ; 498.58 - prior authorization dollars authorized
+10 ; 498.54 - prior authorization number of refills authorized
+11 ; 498.55 - prior authorization quantity accumulated
+12 ; 498.14 - prior authorization number - assigned
+13 ;
+14 ; no repeating fields on this segments so we will simply process
+15 ; what we find
+16 ;
+17 SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,498),U,1)=$GET(FDATA("M",MEDN,498.51))
+18 SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,498),U,2)=$GET(FDATA("M",MEDN,498.52))
+19 SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,498),U,3)=$GET(FDATA("M",MEDN,498.53))
+20 SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,498),U,7)=$GET(FDATA("M",MEDN,498.57))
+21 SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,498),U,8)=$GET(FDATA("M",MEDN,498.58))
+22 SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,498),U,4)=$GET(FDATA("M",MEDN,498.54))
+23 SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,498),U,5)=$GET(FDATA("M",MEDN,498.55))
+24 SET $PIECE(^ABSPR(RESPIEN,1000,INDEX,498),U,6)=$GET(FDATA("M",MEDN,498.14))
+25 ;
+26 ;
+27 QUIT
+28 ;
