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

ABSPOSHF.m

Go to the documentation of this file. 
  1. ABSPOSHF ;IHS/SD/lwj- Get/Format/Set value for DUR/PPS segment [ 09/04/2002  2:09 PM ]
  1.  ;;1.0;PHARMACY POINT OF SALE;**3,23**;JUNE 21,2001;Build 38
  1.  ;
  1.  ; This routine is an addemdum to ABSPOSCF.  Its purpose is to handle
  1.  ; some of the repeating fields that now exist in NCPDP 5.1.  
  1.  ; The logic was put in here rather than ABSPOSCF to keep the original
  1.  ; routine (ABSPOSCF) from growing too large and too cumbersome to
  1.  ; maintain.
  1.  ;
  1.  ; At this point, the only repeating fields we handle in this routine
  1.  ; are those contained in the DUR/PPS segment.
  1.  ;
  1.  ;IHS/SD/RLT - 06/27/07 - 10/18/07 - Patch 23
  1.  ; DIAGNOSIS CODE in CLINICAL Segment.
  1.  ;
  1. DURPPS(FORMAT,NODE,MEDN)     ;EP called from ABSPOSCF  
  1.  ;---------------------------------------------------------------
  1.  ;NCPDP 5.1 changes   
  1.  ; Processing of the 5.1 DUR/PPS segment is much different than the
  1.  ; conventional segments of 3.2, simply because all of its fields
  1.  ; are optional, and repeating.  The repeating portion of this 
  1.  ; causes us to have yet another index we have to account for, and
  1.  ; we must be able to tell which of the fields really needs to be
  1.  ; populated.  The population of this segment is based on those
  1.  ; values found for the prescription or refill in the ABSP DUR/PPS
  1.  ; file.  The file's values are temporarily stored in the
  1.  ; ABSP("RX",MEDN,DUR....) array for easy access and reference.
  1.  ; (Special note - Overrides are not allowed on this multiple since
  1.  ; they can simply update the DUR/PPS filed directly. For the same
  1.  ; reason, "special" code is not accounted for either.
  1.  ;---------------------------------------------------------------
  1.  ;
  1.  ; first order of business - check the ABSP("RX",MEDN,"DUR") array
  1.  ; for values - if there aren't any, we don't need to write this
  1.  ; segment
  1.  ;
  1.  N FIELD,ABSP51,RECCNT,DUR,FLD,OVERRIDE,FLAG,ORD,FLDIEN,FLDNUM
  1.  S FLAG="FS"
  1.  ;
  1.  Q:'$D(ABSP("RX",MEDN,"DUR"))
  1.  ;
  1.  ;next we need to figure out which fields on this format are really
  1.  ; needed, then we will loop through and populate them
  1.  ;
  1.  D GETFLDS(FORMAT,NODE,.FIELD)
  1.  ;
  1.  ; now lets get, format and set the field
  1.  S ABSP51=1 ;needed in the set logic for dual 3.2/5.1 fields
  1.  S (RECCNT,DUR)=0
  1.  F  S DUR=$O(ABSP("RX",MEDN,"DUR",DUR)) Q:DUR=""  D
  1.  . S RECCNT=RECCNT+1
  1.  . S ORD=""
  1.  . F  S ORD=$O(FIELD(ORD)) Q:ORD=""  D
  1.  .. S FLDNUM=$P(FIELD(ORD),U,2)
  1.  .. S FLDIEN=$P(FIELD(ORD),U)
  1.  .. S ABSP("X")=$G(ABSP("RX",MEDN,"DUR",DUR,FLDNUM)) ;get
  1.  .. D XFLDCODE^ABSPOSCF(FLDIEN,FLAG)  ;format/set
  1.  ;
  1.  ; this sets the record count and last record on the subfile
  1.  S ^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),473.01,0)="^9002313.1001A^"_RECCNT_"^"_RECCNT
  1.  ;
  1.  Q
  1.  ;
  1. DIAG(FORMAT,NODE,MEDN)     ;EP called from ABSPOSCF  
  1.  ;DIAGNOSIS CODE in the CLINICAL Segment
  1.  ;
  1.  Q:'$D(ABSP("RX",MEDN,"DIAG"))   ;quit if no data
  1.  ;
  1.  N FIELD,RECCNT,DIAG,FLD,OVERRIDE,FLAG,ORD,FLDIEN,FLDNUM
  1.  S FLAG="FS"
  1.  ;
  1.  ; get list of fields
  1.  D GETFLDS(FORMAT,NODE,.FIELD)
  1.  ;
  1.  ; set field 491 which is not repeating
  1.  S ORD=0
  1.  S FLDNUM=$P(FIELD(ORD),U,2)
  1.  S FLDIEN=$P(FIELD(ORD),U)
  1.  S ABSP("X")=$G(ABSP("RX",MEDN,"DIAG",ORD,FLDNUM)) ;get
  1.  D XFLDCODE^ABSPOSCF(FLDIEN,FLAG)  ;format/set
  1.  ;
  1.  ; get, format and set the field
  1.  S (RECCNT,DIAG)=0
  1.  F  S DIAG=$O(ABSP("RX",MEDN,"DIAG",DIAG)) Q:'+DIAG  D
  1.  . S RECCNT=RECCNT+1
  1.  . S ORD=0
  1.  . F  S ORD=$O(FIELD(ORD)) Q:'+ORD  D
  1.  .. S FLDNUM=$P(FIELD(ORD),U,2)
  1.  .. S FLDIEN=$P(FIELD(ORD),U)
  1.  .. S ABSP("X")=$G(ABSP("RX",MEDN,"DIAG",DIAG,FLDNUM)) ;get
  1.  .. D XFLDCODE^ABSPOSCF(FLDIEN,FLAG)  ;format/set
  1.  ;
  1.  ; set rec count and last rec on the subfile
  1.  S ^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),491.01,0)="^9002313.0701A^"_RECCNT_"^"_RECCNT
  1.  ;
  1.  Q
  1.  ;
  1. GETFLDS(FORMAT,NODE,FIELD) ;EP NCPDP 5.1 
  1.  ;---------------------------------------------------------------
  1.  ;This routine will get the list of repeating fields that must be
  1.  ; be worked with separately
  1.  ; (This was originally coded for the DUR/PPS segment - I'm not
  1.  ; 100% sure how and if it will work for the other repeating
  1.  ; fields that exist within a segment.)
  1.  ;---------------------------------------------------------------
  1.  ; Coming in:
  1.  ;   FORMAT = ABSPF(9002313.92 's format IEN
  1.  ;   NODE   = which segment we are processing (i.e. 180 - DUR/PPS)
  1.  ;  .FIELD  = array to store the values in
  1.  ;
  1.  ; Exitting:
  1.  ;  .FIELD array will look like:
  1.  ;     FIELD(ord)=int^ext
  1.  ;  Where:   ext = external field number from ABSPF(9002313.91
  1.  ;           int = internal field number from ABSPF(9002313.91
  1.  ;           ord = the order of the field - used in creating clm
  1.  ;---------------------------------------------------------------
  1.  ;
  1.  N ORDER,RECMIEN,MDATA,FLDIEN,FLDNUM,DUR
  1.  ;
  1.  S ORDER=0
  1.  ;
  1.  F  D  Q:'ORDER
  1.  . ;
  1.  . ; let's order through the format file for this node
  1.  . ;
  1.  . S ORDER=$O(^ABSPF(9002313.92,FORMAT,NODE,"B",ORDER)) Q:'ORDER
  1.  . S RECMIEN=$O(^ABSPF(9002313.92,FORMAT,NODE,"B",ORDER,0))
  1.  . I 'RECMIEN D IMPOSS^ABSPOSUE("DB","TI","NODE="_NODE,"ORDER="_ORDER,2,$T(+0))
  1.  . S MDATA=^ABSPF(9002313.92,FORMAT,NODE,RECMIEN,0)
  1.  . S FLDIEN=$P(MDATA,U,2)
  1.  . I 'FLDIEN D IMPOSS^ABSPOSUE("DB","TI","NODE="_NODE,"RECMIEN="_RECMIEN,3,$T(+0)) ; corrupt or erroneous format file
  1.  . I '$D(^ABSPF(9002313.91,FLDIEN,0)) D IMPOSS^ABSPOSUE("DB,P","TI","FLDIEN="_FLDIEN,,"DURPPS",$T(+0))  ;incomplete field definition
  1.  . ;
  1.  . ;lets create a list of fields we need
  1.  . S FLDNUM=$P($G(^ABSPF(9002313.91,FLDIEN,0)),U)
  1.  . S:FLDNUM=491 FIELD(0)=FLDIEN_"^"_FLDNUM
  1.  . S:FLDNUM'=111&(FLDNUM'=491) FIELD(ORDER)=FLDIEN_"^"_FLDNUM
  1.  Q