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

ABSPOSSH.m

Go to the documentation of this file.
  1. ABSPOSSH ; IHS/SD/RLT - Special sets for formats - cont; [ 7/11/2007 9:40 AM ]
  1. ;;1.0;PHARMACY POINT OF SALE;**23,29,39**;JUL 11, 2007;Build 38
  1. ;---
  1. ; New diagnosis code fields in clinical segment.
  1. ; Set logic for flds 491, 492 and 424 in this routine to
  1. ; avoid the wrapping within the global which has been known to
  1. ; split when installed on certain systems.
  1. ;---
  1. FLD491 ;DIAGNOSIS CODE COUNT - called from set logic in ABSP NCPDP Field
  1. ;
  1. S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),490),U)=ABSP("X")
  1. ;
  1. Q
  1. ;
  1. FLD492 ;DIAGNOSIS CODE QUALIFIER - called from set logic in ABSP NCPDP Field
  1. ;
  1. Q:$G(DIAG)="" ;IHS/OIT/SCR 2/13/09 patch 29
  1. S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),491.01,DIAG,0),U,2)=ABSP("X")
  1. ;
  1. Q
  1. ;
  1. FLD424 ;DIAGNOSIS CODE - called from set logic in ABSP NCPDP Field
  1. ;
  1. Q:$G(DIAG)="" ;IHS/OIT/SCR 2/13/09 patch 29
  1. S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),491.01,DIAG,0),U,3)=ABSP("X")
  1. ;
  1. Q
  1. ;IHS/CNI/SCR 031710 patch 39 START CHANGES
  1. ;called from set logic in ABSP NCPDP Field Defs repeating field in the COB/Other Payments 5.1 Segment
  1. FLD337 ; COB/Other Paymnts Count
  1. S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),330),U,7)=ABSP("X")
  1. S ^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),337,0)="^9002313.0401A^^"_ABSP("X")
  1. Q
  1. FLD338 ; Other Payer Coverage Type
  1. Q:'$G(ABSPCOB)
  1. S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),337,ABSPCOB,0),U,2)=ABSP("X")
  1. Q
  1. FLD339 ; Other Payer ID Qualifier
  1. Q:'$G(ABSPCOB)
  1. S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),337,ABSPCOB,0),U,3)=ABSP("X")
  1. Q
  1. FLD340 ; Other Payer ID
  1. Q:'$G(ABSPCOB)
  1. S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),337,ABSPCOB,0),U,4)=ABSP("X")
  1. Q
  1. FLD341 ; Other Amt Paid Cnt
  1. Q:'$G(ABSPCOB)
  1. S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),337,ABSPCOB,0),U,6)=ABSP("X")
  1. Q
  1. FLD342 ; Other Payer Amt Paid Qual
  1. Q:'$G(COB)
  1. Q:$G(AMT)=""
  1. S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),337,ABSPCOB,1,AMT,0),U,2)=ABSP("X")
  1. Q
  1. FLD431 ; OTHER PAYOR AMOUNT
  1. Q:'$G(ABSPCOB)
  1. Q:$G(AMT)=""
  1. S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),337,ABSPCOB,1,AMT,0),U,3)=ABSP("X")
  1. Q
  1. FLD443 ; OTHER PAYOR DATE
  1. Q:'$G(ABSPCOB)
  1. S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),337,ABSPCOB,0),U,5)=ABSP("X")
  1. Q
  1. FLD471 ; Other Payer Reject Count
  1. Q:'$G(COB)
  1. Q:$G(AMT)=""
  1. S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),337,COB,0),U,7)=ABSP("X")
  1. Q
  1. FLD472 ; Other Payer Reject Code
  1. Q:'$G(COB)
  1. Q:$G(REJ)=""
  1. S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),337,COB,2,REJ,0),U,2)=ABSP("X")
  1. Q
  1. ;IHS/CNI/SCR 031710 patch 39 END CHANGES