source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCINPT.m@ 1154

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