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

ACPT28PB.m

Go to the documentation of this file. 
  1. ACPT28PB ;IHS/VEN/TOAD - ACPT*2.08*1 postinit step 3 ; 04/20/2008 23:03
  1.  ;;2.08;CPT FILES;**1**;DEC 17, 2007
  1.  ;
  1.  ; This subroutine of the post-init for ACPT*2.08*1 preps the existing
  1.  ; HCPCS codes in the site's CPT file (81) for the loading of the new
  1.  ; 2008 AMA codes. See routine ACPT28PA for the complete algorithm and
  1.  ; overview.
  1.  ;
  1.  QUIT  ; This routine should not be called at the top or anywhere
  1.  ; else. It is only to be called at PREPCODE by ACPT28PA as part of the
  1.  ; post-init for ACPT*2.08*1.
  1.  ;
  1.  ; 2008 04 16-20 Rick Marshall created this routine to handle the HCPCS
  1.  ; prep step of the post-init (step 3). Previously this step just set the 
  1.  ; Date Deleted field (8) to a special value (3080000) prior to loading
  1.  ; the AMS's 2008 HCPCS codes. As each AMA code was loaded, the Date
  1.  ; Deleted was cleared, so that after loading the "deleted" codes in need 
  1.  ; of inactivation could be easily identified. The loop to handle this
  1.  ; was originally in routine ACPTPOST (now called ACPT28PA). During
  1.  ; testing, numerous data integrity problems were found in the CPT file,
  1.  ; so this subroutine was split off into its own new routine and expanded 
  1.  ; to include cleanup of the existing HCPCS data. Problems were mainly
  1.  ; found in the Effective Date subfile, which contained duplicate entries 
  1.  ; and sometimes an erroneous -1 node. The subfile also contained traces
  1.  ; of entries that were deleted though they should not have been; the B
  1.  ; index is used to recreate these lost entries, and the subfile as a
  1.  ; whole is renumbered and reindexed.
  1.  ;
  1.  ; The original loop from ACPTPOST was the work of IHS/ASDST/DMJ and
  1.  ; Shonda Render (SDR).
  1.  ;
  1.  ;
  1. PREPCODE ; step 3 of post-init: prep site's existing HCPCS codes
  1.  ;
  1.  ; private: called only by step 3 of routine ACPT28PA
  1.  ;
  1.  ; input: ACPTYR = 3080000, to use as the flag value for the Date Deleted
  1.  ; field.
  1.  ;
  1.  ; 3.1. traverse site's existing HCPCS codes in the CPT file
  1.  ;
  1.  N ACPTCNT
  1.  N ACPTIEN S ACPTIEN=99999 ; IENs of HCPCS entries, start just before
  1.  N ACPTTO S ACPTTO=999999 ; last IEN in HCPCS range
  1.  F ACPTCNT=1:1 S ACPTIEN=$O(^ICPT(ACPTIEN)) Q:ACPTIEN>ACPTTO!'ACPTIEN  D
  1.  . ;
  1.  . ; 3.2. set Date Deleted field to flag value
  1.  . ;
  1.  . I '$P($G(^ICPT(ACPTIEN,0)),U,7) D  ; if it hasn't already been deleted
  1.  . . S $P(^ICPT(ACPTIEN,0),U,7)=ACPTYR ; set its Date Deleted field (8)
  1.  . ;
  1.  . ; 3.3. clean up Effective Date subfile
  1.  . ;
  1.  . D CLEANUP(ACPTIEN)
  1.  . I '(ACPTCNT#100) U IO(0) W "." ; print a dot every 100 records
  1.  ;
  1.  ;
  1.  QUIT  ; end of PREPCODE
  1.  ;
  1.  ;
  1. CLEANUP(ACPTIEN) ; clean up Effective Date subfile for a CPT entry
  1.  ;
  1.  ; private, called only by PREPCODE above
  1.  ;
  1.  ; this subroutine has been separated from PREPCODE to make
  1.  ; testing easier.
  1.  ;
  1.  ; a. build local subfile, dinummed by date, out of subentries
  1.  ;
  1.  N ACPTDATE ; local subfile
  1.  N ACPTEDI S ACPTEDI=0 ; Effective Date IEN
  1.  F  S ACPTEDI=$O(^ICPT(ACPTIEN,60,ACPTEDI)) Q:'ACPTEDI  D
  1.  . N ACPTNODE S ACPTNODE=$G(^ICPT(ACPTIEN,60,ACPTEDI,0)) Q:ACPTNODE=""
  1.  . N ACPTED S ACPTED=$P(ACPTNODE,U) Q:'ACPTED  ; skip nonnumerics
  1.  . D  ; handle insertions into the list
  1.  . . I '$D(ACPTDATE(ACPTED)) D  Q  ; if new to the local list, add it
  1.  . . . S ACPTDATE(ACPTED)=ACPTNODE ; later entries overwrite earlier
  1.  . . N ACPTSTAT S ACPTSTAT=$P(ACPTNODE,U,2) ; Status field (.02)
  1.  . . I ACPTSTAT'="" D  Q  ; if it has a status
  1.  . . . S $P(ACPTDATE(ACPTED),U,2)=ACPTSTAT ; it overrides the older entry
  1.  . K ^ICPT(ACPTIEN,60,"B",ACPTED) ; remove found dates
  1.  ;
  1.  ; b. extend local subfile with lost entries in B index
  1.  ;
  1.  N ACPTS1 S ACPTS1="" ; 1st subscript of B index entries
  1.  F  S ACPTS1=$O(^ICPT(ACPTIEN,60,"B",ACPTS1)) Q:ACPTS1=""  D
  1.  . Q:'ACPTS1  ; skip nonnumeric entries
  1.  . Q:$D(ACPTDATE(ACPTS1))  ; skip if already found (just in case)
  1.  . S ACPTDATE(ACPTS1)=ACPTS1 ; create stub entries for lost entries
  1.  ;
  1.  ; c. replace global subfile with local subfile
  1.  ;
  1.  K ^ICPT(ACPTIEN,60) ; first clear out old subfile (incl -1 nodes)
  1.  ;
  1.  ; then copy local subfile to global subfile
  1.  N ACPTEMP S ACPTEMP=0 ; temporary IENs in local subfile
  1.  N ACPTNEW ; new IEN for each subentry
  1.  F ACPTNEW=1:1 S ACPTEMP=$O(ACPTDATE(ACPTEMP)) Q:'ACPTEMP  D
  1.  . S ^ICPT(ACPTIEN,60,ACPTNEW,0)=ACPTDATE(ACPTEMP) ; move entry
  1.  . S ^ICPT(ACPTIEN,60,"B",ACPTEMP,ACPTNEW)="" ; create B index entry
  1.  S ACPTNEW=ACPTNEW-1 ; reduce to actual number of subentries
  1.  ;
  1.  ; last, reset the subheader
  1.  S ^ICPT(ACPTIEN,60,0)="^81.02DA^"_ACPTNEW_U_ACPTNEW
  1.  ;
  1.  QUIT  ; end of CLEANUP
  1.  ;
  1.  ;
  1.  ; end of routine ACPT28PB