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

IBCINPT.m

Go to the documentation of this file. 
  1. IBCINPT ;DSI/ESG - Extract data and create NPT file ;27-DEC-2000
  1.  ;;2.0;INTEGRATED BILLING;**161**;21-MAR-94
  1.  ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1. ENTRY ; Entry point for routine (or called from the top)
  1.  NEW IBCIRTN,STOP,IBCIPATH,IBCIFILE
  1.  D INIT
  1.  D INTRO
  1.  I STOP G EXIT
  1.  D GETPATH             ; get the NPT file location & Open the file
  1.  I STOP G EXIT
  1.  D EXTRACT             ; build the scratch global
  1.  D OUTPUT              ; build the file
  1. EXIT ;
  1.  ; Routine Exit
  1.  Q
  1.  ;
  1.  ;
  1. INIT ; Procedure to initialize some routine-wide variables
  1.  S IBCIRTN="IBCINPT"              ; routine name, IO handle
  1.  S STOP=0                         ; stop flag
  1.  S IBCIFILE="IBCINPT.DAT"         ; name of file that gets created
  1. INITX ;
  1.  Q
  1.  ;
  1.  ;
  1. INTRO ; This procedure displays introductory text and asks if the user
  1.  ; wants to proceed with the creation of the NPT file.
  1.  ;
  1.  W @IOF
  1.  NEW Y,STARTDT,ENDDT,IBCIMSG,DIR,X,DTOUT,DUOUT,DIRUT,DIROUT
  1.  ;
  1.  S Y=DT-30000 D DD^%DT S STARTDT=Y
  1.  S Y=DT D DD^%DT S ENDDT=Y
  1.  S IBCIMSG(1)=" This option is responsible for creating the NPT file"
  1.  S IBCIMSG(2)=" (New Patient History) for the ClaimsManager application from Ingenix."
  1.  S IBCIMSG(3)=" A 3 year history is needed so this option will extract claims data"
  1.  S IBCIMSG(4)=" from "_STARTDT_" through "_ENDDT_"."
  1.  S IBCIMSG(5)=" This process may take several minutes."
  1.  S IBCIMSG(6)=""
  1.  ;
  1.  S IBCIMSG(3,"F")="!!"
  1.  S IBCIMSG(5,"F")="!!"
  1.  ;
  1.  DO EN^DDIOL(.IBCIMSG)
  1.  ;
  1.  ; Now for the user response
  1.  ;
  1.  S DIR(0)="Y"
  1.  S DIR("A")=" Do you wish to proceed"
  1.  S DIR("B")="NO"
  1.  DO ^DIR
  1.  I 'Y S STOP=1
  1. INTROX ;
  1.  Q
  1.  ;
  1.  ;
  1. GETPATH ; This procedure tries to get a valid directory location or path
  1.  ; from the user.  The file is also opened in this procedure.
  1.  ;
  1.  NEW IBCIMSG,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,POP
  1.  ;
  1.  ; Some introductory text for the user
  1.  S IBCIMSG(1)=" The file that will be created is called "_IBCIFILE_"."
  1.  S IBCIMSG(2)=" You may specify a valid directory location (path) for this file."
  1.  S IBCIMSG(3)=" After this file has been created, it needs to be accessible to the"
  1.  S IBCIMSG(4)=" ClaimsManager application.  This can be done either through network"
  1.  S IBCIMSG(5)=" connections or by manually moving it to the ClaimsManager server."
  1.  S IBCIMSG(6)=""
  1.  ;
  1.  S IBCIMSG(1,"F")="!!"
  1.  S IBCIMSG(2,"F")="!!"
  1.  S IBCIMSG(3,"F")="!!"
  1.  ;
  1.  DO EN^DDIOL(.IBCIMSG)
  1.  ;
  1.  ; read user response to directory question
  1.  ;
  1. GET1 ;
  1.  KILL DIR
  1.  S DIR(0)="FOr"
  1.  S DIR("A")=" Directory"
  1.  S DIR("A",1)=" Please enter the directory location (path) for "_IBCIFILE
  1.  S DIR("A",2)=""
  1.  S DIR("B")=$$PWD^%ZISH()   ; retrieves the current directory
  1.  S DIR("?")=" Enter the location where the file should be created."
  1.  S DIR("?",1)=" Enter the full path specification up to, but not including,"
  1.  S DIR("?",2)=" the filename.  This includes any trailing slashes or brackets."
  1.  S DIR("?",3)=" If the operating system allows shortcuts, you can use them."
  1.  S DIR("?",4)=" Examples of valid paths include:"
  1.  S DIR("?",5)=""
  1.  S DIR("?",6)="     DOS/Win      c:\scratch\"
  1.  S DIR("?",7)="     UNIX         /home/scratch/"
  1.  S DIR("?",8)="     VMS          USER$:[SCRATCH]"
  1.  S DIR("?",9)=""
  1.  ;
  1.  DO ^DIR
  1.  ;
  1.  ; Process the user response
  1.  ;
  1.  I $D(DTOUT) S STOP=1 G GETPTHX        ; time-out
  1.  I $D(DUOUT) S STOP=1 G GETPTHX        ; any leading "^" input
  1.  ;
  1.  ; save the path in the proper variable name
  1.  S IBCIPATH=Y
  1.  ;
  1.  ; attempt to open the file
  1.  DO OPEN^%ZISH(IBCIRTN,IBCIPATH,IBCIFILE,"W")
  1.  U IO(0)
  1.  ;
  1.  I POP D  G GET1
  1.  . ;
  1.  . ; This means that the file was not opened.
  1.  . K IBCIMSG
  1.  . S IBCIMSG(1)=" """_IBCIPATH_""" is not a valid directory location or path."
  1.  . S IBCIMSG(2)=" Please press ""?"" for more assistance."
  1.  . S IBCIMSG(3)=""
  1.  . ;
  1.  . S IBCIMSG(1,"F")="!!"
  1.  . ;
  1.  . DO EN^DDIOL(.IBCIMSG)
  1.  . Q
  1.  ;
  1.  ; At this point, the file has been opened successfully.
  1.  ; Display a message about the full file spec and get final confirmation
  1.  ;
  1.  KILL IBCIMSG,DIR
  1.  S IBCIMSG(1)=" The full file specification including path and filename is:"
  1.  S IBCIMSG(2)=""
  1.  S IBCIMSG(3)="     "_IBCIPATH_IBCIFILE
  1.  S IBCIMSG(4)=""
  1.  ;
  1.  S IBCIMSG(1,"F")="!!"
  1.  ;
  1.  DO EN^DDIOL(.IBCIMSG)
  1.  ;
  1.  ; Now for the final user confirmation
  1.  ;
  1.  S DIR(0)="Y"
  1.  S DIR("A")=" OK to begin"
  1.  S DIR("B")="YES"
  1.  DO ^DIR
  1.  ;
  1.  I 'Y D  G GET1                ; user said NO to begin the extract
  1.  . DO CLOSE^%ZISH(IBCIRTN)     ; close the file
  1.  . DO EN^DDIOL(" ")            ; write a blank line to the screen
  1.  . Q
  1.  ;
  1. GETPTHX ;
  1.  Q
  1.  ;
  1.  ;
  1. EXTRACT ; This procedure extracts the data for the NPT file into a scratch
  1.  ; global.
  1.  ;
  1.  NEW STARTDT,EVNDT,D0,BILL,STATUS,DFN,D1,PROC,IBCIPROV,IBCIPRDT,HCFA,SSN
  1.  NEW TOTBILLS,TOTRECS,DISPMON,DISPYR,MONTH,SAVMONTH,IBCIMSG,X,Y,%H
  1.  S TOTBILLS=0,TOTRECS=0
  1.  KILL ^TMP($J,IBCIRTN)      ; initialize scratch global with user/date
  1.  S %H=$H DO YX^%DTC
  1.  S ^TMP($J,IBCIRTN)=DUZ_U_Y
  1.  DO EN^DDIOL(" ")       ; write blank line
  1.  DO WAIT^DICD           ; message telling user to wait
  1.  DO EN^DDIOL(" ")       ; write blank line
  1.  S STARTDT=DT-30000     ; three years ago
  1.  S STARTDT=$O(^DGCR(399,"D",STARTDT),-1)
  1.  S EVNDT=STARTDT
  1.  S SAVMONTH=""
  1.  F  S EVNDT=$O(^DGCR(399,"D",EVNDT)) Q:'EVNDT  D
  1.  . S MONTH=$E(EVNDT,4,5)
  1.  . I MONTH'=SAVMONTH D
  1.  .. S Y=EVNDT D DD^%DT
  1.  .. S DISPMON=$E(Y,1,3)
  1.  .. S DISPYR=$E(Y,9,12)
  1.  .. DO EN^DDIOL("    Processing "_DISPMON_" "_DISPYR)
  1.  .. S SAVMONTH=MONTH
  1.  .. Q
  1.  . S D0=0
  1.  . F  S D0=$O(^DGCR(399,"D",EVNDT,D0)) Q:'D0  D
  1.  .. S TOTBILLS=TOTBILLS+1
  1.  .. S BILL=$G(^DGCR(399,D0,0))
  1.  .. S STATUS=$P(BILL,U,13)             ; field #.13 STATUS
  1.  .. I STATUS="" Q
  1.  .. I $F(".1.7.","."_STATUS_".") Q     ; we don't want these
  1.  .. S DFN=$P(BILL,U,2)                 ; field #.02 PATIENT NAME
  1.  .. S SSN=$P($G(^DPT(DFN,0)),U,9)      ; SSN# of patient
  1.  .. I SSN="" Q
  1.  .. ;
  1.  .. ; esg - 6/8/01
  1.  .. ; Use the new Patch 51 procedures to get the provider data if
  1.  .. ; there is data in the provider multiple.
  1.  .. ; Use the Operating (2), Rendering (3), and Attending (4) providers
  1.  .. ; and get their specialties to build the patient history file.
  1.  .. ;
  1.  .. I $P($G(^DGCR(399,D0,"PRV",0)),U,4) D
  1.  ... NEW PRVTYP,IBXARRAY,IBXARRY,IBXDATA,IBXERR,IBPRV
  1.  ... S IBCIPRDT=$P(EVNDT,".",1)         ; use the bill's event date
  1.  ... I IBCIPRDT="" Q
  1.  ... D F^IBCEF("N-ALL PROVIDERS",,,D0)  ; Patch 51 utility
  1.  ... F PRVTYP=2,3,4 D
  1.  .... S IBPRV=$P($G(IBXDATA(PRVTYP,1)),U,3)
  1.  .... S HCFA=$$BILLSPEC^IBCEU3(D0,IBPRV)
  1.  .... I HCFA="" Q
  1.  .... ;
  1.  .... ; All the data should be here so file it
  1.  .... ; Update the record counter if we've never seen this
  1.  .... ; patient/specialty pairing before
  1.  .... I '$D(^TMP($J,IBCIRTN,SSN,HCFA)) S TOTRECS=TOTRECS+1
  1.  .... S ^TMP($J,IBCIRTN,SSN,HCFA,IBCIPRDT)=""
  1.  .... Q
  1.  ... Q
  1.  .. ;
  1.  .. ; Now loop through the procedures sub-file and extract data
  1.  .. S D1=0
  1.  .. F  S D1=$O(^DGCR(399,D0,"CP",D1)) Q:'D1  D
  1.  ... S PROC=$G(^DGCR(399,D0,"CP",D1,0))
  1.  ... S IBCIPROV=$P(PROC,U,18)          ; field #18 PROVIDER
  1.  ... I IBCIPROV="" Q
  1.  ... S IBCIPRDT=$P(PROC,U,2)           ; field #1 PROCEDURE DATE
  1.  ... I IBCIPRDT="" Q
  1.  ... ;
  1.  ... ; invoke utility from Kernel patch XU*8.0*132
  1.  ... S HCFA=$$GET^XUA4A72(IBCIPROV,IBCIPRDT)
  1.  ... S HCFA=$P(HCFA,U,8)               ; 2-digit HCFA specialty code
  1.  ... I HCFA="" Q
  1.  ... ;
  1.  ... ; All the data should be here so file it
  1.  ... ; Update the record counter if we've never seen this
  1.  ... ; patient/specialty pairing before
  1.  ... I '$D(^TMP($J,IBCIRTN,SSN,HCFA)) S TOTRECS=TOTRECS+1
  1.  ... S ^TMP($J,IBCIRTN,SSN,HCFA,IBCIPRDT)=""
  1.  ... Q
  1.  .. Q
  1.  . Q
  1.  ;
  1.  ;
  1.  KILL IBCIMSG
  1.  S IBCIMSG(1)=" The compile process has completed successfully."
  1.  S IBCIMSG(2)=" The number of bills that were reviewed is "_$FN(TOTBILLS,",")_"."
  1.  S IBCIMSG(3)=" The number of records that will be in the NPT file is "_$FN(TOTRECS,",")_"."
  1.  S IBCIMSG(4)=" All that's left to do is to copy these records into the NPT file."
  1.  S IBCIMSG(5)=""
  1.  ;
  1.  S IBCIMSG(1,"F")="!!"
  1.  S IBCIMSG(2,"F")="!!"
  1.  S IBCIMSG(4,"F")="!!"
  1.  ;
  1.  DO EN^DDIOL(.IBCIMSG)
  1.  ;
  1. EXTRX ;
  1.  Q
  1.  ;
  1.  ;
  1. OUTPUT ; This procedure loops through the scratch global and writes each
  1.  ; record to the open file.  We only need to write the record with
  1.  ; the most recent date of service for each patient/HCFA specialty
  1.  ; code pair.  This is why we are not looping through all dates,
  1.  ; but doing a $Order with the -1 parameter to get the most recent
  1.  ; date.  The file is also closed in this procedure and a confirmation
  1.  ; message is shown to the user.
  1.  ;
  1.  NEW SSN,HCFA,DATE,SVCDT,IBCIMSG,POP,X,X1,X2,X3,X4,Y
  1.  ;
  1.  ; Use the file for writing
  1.  U IO
  1.  ;
  1.  ; loop through global and output record into file
  1.  S (SSN,HCFA)=""
  1.  F  S SSN=$O(^TMP($J,IBCIRTN,SSN)) Q:SSN=""  D
  1.  . F  S HCFA=$O(^TMP($J,IBCIRTN,SSN,HCFA)) Q:HCFA=""  D
  1.  .. S DATE=$O(^TMP($J,IBCIRTN,SSN,HCFA,""),-1)
  1.  .. S SVCDT=($E(DATE,1,3)+1700)_$E(DATE,4,7)
  1.  .. ;
  1.  .. ; Output the records to the file
  1.  .. S X=SSN,X1=20,X4="T" W $$FILL^IBCIUT2
  1.  .. S X=HCFA,X1=10,X4="T" W $$FILL^IBCIUT2
  1.  .. S X=SVCDT,X1=17,X4="T" W $$FILL^IBCIUT2
  1.  .. W !
  1.  .. Q
  1.  . Q
  1.  ;
  1.  ; The file has been created so close it and tell the user
  1.  DO CLOSE^%ZISH(IBCIRTN)
  1.  U IO(0)
  1.  S IBCIMSG(1)=" The NPT file creation process is complete!"
  1.  S IBCIMSG(2)=""
  1.  S IBCIMSG(1,"F")="!!"
  1.  DO EN^DDIOL(.IBCIMSG)
  1.  ;
  1.  ; clean up the scratch global
  1.  KILL ^TMP($J,IBCIRTN)
  1.  ;
  1. OUTPUTX ;
  1.  Q
  1.  ;