Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABSPOSH7

ABSPOSH7.m

Go to the documentation of this file. 
  1. 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
  1.  ;-------------------------------------------------------------
  1.  ; Originally, the entire response was processed in the 
  1.  ; ABSPOSH5 routine - but it exceed SAC limitations on 
  1.  ; routine size - so the processing of some of the transaction 
  1.  ; level information was moved to this routine. Other portions
  1.  ; were moved to the ABSPOSH6 routine.
  1.  ; 
  1.  ; This routine is called solely from ABSPOSH5.
  1.  ;
  1.  ;
  1.  Q
  1. RESPPRC ;EP  - NCPDP 5.1 response processing (moved from ABSPOSH5)  
  1.  ; called from WRTTRAN^ABSPOSH5
  1.  ; MEDN is set in ABSPOSH5 in the WRTTRAN subroutine
  1.  ; process the response pricing segment - here's the fields we MIGHT 
  1.  ; encounter:
  1.  ; 505 - patient pay amount
  1.  ; 506 - ingredient code paid
  1.  ; 507 - dispensing fee paid
  1.  ; 557 - tax exempt indicator
  1.  ; 558 - flat sales tax amount paid
  1.  ; 559 - percentage sales tax amount paid
  1.  ; 560 - percentage sales tax rate paid
  1.  ; 561 - percentage sales tax basis paid
  1.  ; 521 - incentive amount paid
  1.  ; 562 - professional service fee paid
  1.  ; 563 - other amount paid count
  1.  ; 564 - other amount paid qualifier (repeating)
  1.  ; 565 - other amount paid (repeating)
  1.  ; 566 - other payer amount recognized
  1.  ; 509 - total amount paid
  1.  ; 522 - basis of reimbursement determination
  1.  ; 523 - amount attributed to sales tax
  1.  ; 512 - accumulated deductible amount
  1.  ; 513 - remaining deductible amount
  1.  ; 514 - remaining benefit amount
  1.  ; 517 - amount applied to periodic deductible
  1.  ; 518 - amount of copay/co-insurance
  1.  ; 519 - amount attributed to product selection
  1.  ; 520 - amount exceeding periodic benefit maximum
  1.  ; 346 - basis of calculation - dispensing fee
  1.  ; 347 - basis of calculation - copay
  1.  ; 348 - basis of calculation - flat sales tax
  1.  ; 349 - basis of calculation - percentage sales tax
  1.  ;
  1.  ; process everything up to the repeating fields
  1.  S $P(^ABSPR(RESPIEN,1000,INDEX,500),U,5)=$G(FDATA("M",MEDN,505))
  1.  S $P(^ABSPR(RESPIEN,1000,INDEX,500),U,6)=$G(FDATA("M",MEDN,506))
  1.  S $P(^ABSPR(RESPIEN,1000,INDEX,500),U,7)=$G(FDATA("M",MEDN,507))
  1.  S $P(^ABSPR(RESPIEN,1000,INDEX,550),U,7)=$G(FDATA("M",MEDN,557))
  1.  S $P(^ABSPR(RESPIEN,1000,INDEX,550),U,8)=$G(FDATA("M",MEDN,558))
  1.  S $P(^ABSPR(RESPIEN,1000,INDEX,550),U,9)=$G(FDATA("M",MEDN,559))
  1.  S $P(^ABSPR(RESPIEN,1000,INDEX,550),U,10)=$G(FDATA("M",MEDN,560))
  1.  S $P(^ABSPR(RESPIEN,1000,INDEX,560),U)=$G(FDATA("M",MEDN,561))
  1.  S $P(^ABSPR(RESPIEN,1000,INDEX,500),U,21)=$G(FDATA("M",MEDN,521))
  1.  S $P(^ABSPR(RESPIEN,1000,INDEX,560),U,2)=$G(FDATA("M",MEDN,562))
  1.  ;
  1.  ; figure out if we have any of the other paid amount repeating flds
  1.  S $P(^ABSPR(RESPIEN,1000,INDEX,560),U,3)=$G(FDATA("M",MEDN,563))
  1.  I $D(FDATA("M",MEDN,563)) D REPOPA      ;process the repeating flds
  1.  ;
  1.  ; now back to the reqular fields
  1.  S $P(^ABSPR(RESPIEN,1000,INDEX,560),U,6)=$G(FDATA("M",MEDN,566))
  1.  S $P(^ABSPR(RESPIEN,1000,INDEX,500),U,9)=$G(FDATA("M",MEDN,509))
  1.  S $P(^ABSPR(RESPIEN,1000,INDEX,500),U,22)=$G(FDATA("M",MEDN,522))
  1.  S $P(^ABSPR(RESPIEN,1000,INDEX,500),U,23)=$G(FDATA("M",MEDN,523))
  1.  S $P(^ABSPR(RESPIEN,1000,INDEX,500),U,12)=$G(FDATA("M",MEDN,512))
  1.  S $P(^ABSPR(RESPIEN,1000,INDEX,500),U,13)=$G(FDATA("M",MEDN,513))
  1.  S $P(^ABSPR(RESPIEN,1000,INDEX,500),U,14)=$G(FDATA("M",MEDN,514))
  1.  S $P(^ABSPR(RESPIEN,1000,INDEX,500),U,17)=$G(FDATA("M",MEDN,517))
  1.  S $P(^ABSPR(RESPIEN,1000,INDEX,500),U,18)=$G(FDATA("M",MEDN,518))
  1.  S $P(^ABSPR(RESPIEN,1000,INDEX,500),U,19)=$G(FDATA("M",MEDN,519))
  1.  S $P(^ABSPR(RESPIEN,1000,INDEX,500),U,20)=$G(FDATA("M",MEDN,520))
  1.  S $P(^ABSPR(RESPIEN,1000,INDEX,340),U,6)=$G(FDATA("M",MEDN,346))
  1.  S $P(^ABSPR(RESPIEN,1000,INDEX,340),U,7)=$G(FDATA("M",MEDN,347))
  1.  S $P(^ABSPR(RESPIEN,1000,INDEX,340),U,8)=$G(FDATA("M",MEDN,348))
  1.  S $P(^ABSPR(RESPIEN,1000,INDEX,340),U,9)=$G(FDATA("M",MEDN,349))
  1.  ;
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. REPOPA ; This subroutine will process the other amount paid repeating fields 
  1.  ; that are a part of the pricing segment.
  1.  ; Two fields here - 564 - other amount paid qualifier 
  1.  ;                   565 - other amount paid
  1.  ;
  1.  N CNTR,COUNT,AMTPDQ,AMTPD,CKREC
  1.  ;
  1.  S RLCNT=0
  1.  S COUNT=$G(FDATA("M",MEDN,563))    ;other amoutn paid count
  1.  Q:COUNT'>0
  1.  ;
  1.  F CNTR=1:1:COUNT  D
  1.  . S (AMTPDQ,AMTPD)=""
  1.  . S AMTPDQ=$G(FDATA("M",MEDN,564,CNTR))  ;other amount paid qual
  1.  . S AMTPD=$G(FDATA("M",MEDN,565,CNTR))   ;other amount paid
  1.  . S CKREC=AMTPDQ_AMTPD                   ;quick chk for values
  1.  . I $D(CKREC) D
  1.  .. S $P(^ABSPR(RESPIEN,1000,INDEX,563.01,CNTR,0),U)=CNTR
  1.  .. S ^ABSPR(RESPIEN,1000,INDEX,563.01,"B",CNTR,CNTR)=""
  1.  .. S RLCNT=RLCNT+1
  1.  . S:$D(AMTPDQ) $P(^ABSPR(RESPIEN,1000,INDEX,563.01,CNTR,1),U,1)=AMTPDQ
  1.  . S:$D(AMTPD) $P(^ABSPR(RESPIEN,1000,INDEX,563.01,CNTR,1),U,2)=AMTPD
  1.  ;
  1.  I RLCNT>0 D
  1.  . S ^ABSPR(RESPIEN,1000,INDEX,563.01,0)="^9002313.1401A^"_RLCNT_"^"_RLCNT
  1.  ;
  1.  Q
  1.  ;
  1. RESPDUR ;EP  - NCPDP 5.1 response processing (moved from ABSPOSH5)  
  1.  ; called from WRTTRAN^ABSPOSH5
  1.  ; MEDN is set in ABSPOSH5 in the WRTTRAN subroutine
  1.  ; process the response DUR segment - here's the fields we MIGHT 
  1.  ; encounter:
  1.  ; 567 - DUR/PPS Response Code counter (repeating)
  1.  ; 439 - reason for service (repeating)
  1.  ; 528 - clinical significance code (repeating)
  1.  ; 529 - other pharmacy indicator (repeating)
  1.  ; 530 - previous date of fill (repeating)
  1.  ; 531 - quanityt of previous fill (repeating)
  1.  ; 532 - database indicator (repeating)
  1.  ; 533 - other prescriber indicator (repeating)
  1.  ; 544 - DUR free text message (repeating)
  1.  ;
  1.  ; All fields on this segment are not only optional, but also
  1.  ; repeating.  Please note that field 567 is NOT a count, but
  1.  ; a counter, which changes how we process this repeating
  1.  ; segment.  Since this entire record is repeating, and the
  1.  ; logic is different, we will keep it here, rather than have
  1.  ; it call a separate repeating subroutine.
  1.  ;
  1.  ;
  1.  N CNTR,RLCNT,RSNCD,CLINCD,OTHPHM,PREVDT,PRVQTY,DBID,OTHPRS,FREETX
  1.  ;
  1.  Q:'$D(FDATA("M",MEDN,567))  ;just quit if there isn't anything
  1.  ;
  1.  S (CNTR,RLCNT)=0
  1.  ;
  1.  F  S CNTR=$O(FDATA("M",MEDN,567,CNTR)) Q:CNTR=""  D
  1.  . ;first lets retrieve the values for this record
  1.  . S RLCNT=RLCNT+1
  1.  . S (RSNCD,CLINCD,OTHPHM,PREVDT,PRVQTY,DBID,OTHPRS,FREETX)=""
  1.  . S RSNCD=$G(FDATA("M",MEDN,439,CNTR))  ;reason for service code 
  1.  . S CLINCD=$G(FDATA("M",MEDN,528,CNTR)) ;clinical significance code
  1.  . S OTHPHM=$G(FDATA("M",MEDN,529,CNTR)) ;other pharmacy indicator
  1.  . S PREVDT=$G(FDATA("M",MEDN,530,CNTR)) ;previous date of fill
  1.  . S PRVQTY=$G(FDATA("M",MEDN,531,CNTR)) ;quantity of previous fill
  1.  . S DBID=$G(FDATA("M",MEDN,532,CNTR))   ;database indicator
  1.  . S OTHPRS=$G(FDATA("M",MEDN,533,CNTR)) ;other prescriber indicator
  1.  . S FREETX=$G(FDATA("M",MEDN,544,CNTR)) ;DUR free text message 
  1.  . ;
  1.  . ; now lets set the response file with the values we just got
  1.  . ; don't forget that we have to hard set the "b" xref too
  1.  . S $P(^ABSPR(RESPIEN,1000,INDEX,567.01,CNTR,0),U)=CNTR
  1.  . S ^ABSPR(RESPIEN,1000,INDEX,567.01,"B",CNTR,CNTR)=""
  1.  . S:$D(RSNCD) $P(^ABSPR(RESPIEN,1000,INDEX,567.01,CNTR,0),U,2)=RSNCD
  1.  . S:$D(CLINCD) $P(^ABSPR(RESPIEN,1000,INDEX,567.01,CNTR,0),U,3)=CLINCD
  1.  . S:$D(OTHPHM) $P(^ABSPR(RESPIEN,1000,INDEX,567.01,CNTR,0),U,4)=OTHPHM
  1.  . S:$D(PREVDT) $P(^ABSPR(RESPIEN,1000,INDEX,567.01,CNTR,0),U,5)=PREVDT
  1.  . S:$D(PRVQTY) $P(^ABSPR(RESPIEN,1000,INDEX,567.01,CNTR,0),U,6)=PRVQTY
  1.  . S:$D(DBID) $P(^ABSPR(RESPIEN,1000,INDEX,567.01,CNTR,0),U,7)=DBID
  1.  . S:$D(OTHPRS) $P(^ABSPR(RESPIEN,1000,INDEX,567.01,CNTR,0),U,8)=OTHPRS
  1.  . S:$D(FREETX) $P(^ABSPR(RESPIEN,1000,INDEX,567.01,CNTR,0),U,9)=FREETX
  1.  ;
  1.  I RLCNT>0 D
  1.  . S ^ABSPR(RESPIEN,1000,INDEX,567.01,0)="^9002313.1101A^"_RLCNT_"^"_RLCNT
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. RESPPA ;EP  - NCPDP 5.1 response processing (moved from ABSPOSH5)  
  1.  ; called from WRTTRAN^ABSPOSH5
  1.  ; MEDN is set in ABSPOSH5 in the WRTTRAN subroutine
  1.  ; process the response prior authorization segment - here's the  
  1.  ; fields we MIGHT encounter:
  1.  ; 498.51 - prior authorization processed date
  1.  ; 498.52 - prior authorization effective date
  1.  ; 498.53 - prior authorization expiration date
  1.  ; 498.57 - prior authorization quantity
  1.  ; 498.58 - prior authorization dollars authorized
  1.  ; 498.54 - prior authorization number of refills authorized
  1.  ; 498.55 - prior authorization quantity accumulated
  1.  ; 498.14 - prior authorization number - assigned
  1.  ;
  1.  ; no repeating fields on this segments so we will simply process
  1.  ; what we find
  1.  ;
  1.  S $P(^ABSPR(RESPIEN,1000,INDEX,498),U,1)=$G(FDATA("M",MEDN,498.51))
  1.  S $P(^ABSPR(RESPIEN,1000,INDEX,498),U,2)=$G(FDATA("M",MEDN,498.52))
  1.  S $P(^ABSPR(RESPIEN,1000,INDEX,498),U,3)=$G(FDATA("M",MEDN,498.53))
  1.  S $P(^ABSPR(RESPIEN,1000,INDEX,498),U,7)=$G(FDATA("M",MEDN,498.57))
  1.  S $P(^ABSPR(RESPIEN,1000,INDEX,498),U,8)=$G(FDATA("M",MEDN,498.58))
  1.  S $P(^ABSPR(RESPIEN,1000,INDEX,498),U,4)=$G(FDATA("M",MEDN,498.54))
  1.  S $P(^ABSPR(RESPIEN,1000,INDEX,498),U,5)=$G(FDATA("M",MEDN,498.55))
  1.  S $P(^ABSPR(RESPIEN,1000,INDEX,498),U,6)=$G(FDATA("M",MEDN,498.14))
  1.  ;
  1.  ;
  1.  Q
  1.  ;