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
;
;
; 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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCINPT 9496 printed Apr 09, 2024@21:30:17 Page 2
IBCINPT ;DSI/ESG - Extract data and create NPT file ;27-DEC-2000
+1 ;;2.0;INTEGRATED BILLING;**161**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
ENTRY ; Entry point for routine (or called from the top)
+1 NEW IBCIRTN,STOP,IBCIPATH,IBCIFILE
+2 DO INIT
+3 DO INTRO
+4 IF STOP
GOTO EXIT
+5 ; get the NPT file location & Open the file
DO GETPATH
+6 IF STOP
GOTO EXIT
+7 ; build the scratch global
DO EXTRACT
+8 ; build the file
DO OUTPUT
EXIT ;
+1 ; Routine Exit
+2 QUIT
+3 ;
+4 ;
INIT ; Procedure to initialize some routine-wide variables
+1 ; routine name, IO handle
SET IBCIRTN="IBCINPT"
+2 ; stop flag
SET STOP=0
+3 ; name of file that gets created
SET IBCIFILE="IBCINPT.DAT"
INITX ;
+1 QUIT
+2 ;
+3 ;
INTRO ; This procedure displays introductory text and asks if the user
+1 ; wants to proceed with the creation of the NPT file.
+2 ;
+3 WRITE @IOF
+4 NEW Y,STARTDT,ENDDT,IBCIMSG,DIR,X,DTOUT,DUOUT,DIRUT,DIROUT
+5 ;
+6 SET Y=DT-30000
DO DD^%DT
SET STARTDT=Y
+7 SET Y=DT
DO DD^%DT
SET ENDDT=Y
+8 SET IBCIMSG(1)=" This option is responsible for creating the NPT file"
+9 SET IBCIMSG(2)=" (New Patient History) for the ClaimsManager application from Ingenix."
+10 SET IBCIMSG(3)=" A 3 year history is needed so this option will extract claims data"
+11 SET IBCIMSG(4)=" from "_STARTDT_" through "_ENDDT_"."
+12 SET IBCIMSG(5)=" This process may take several minutes."
+13 SET IBCIMSG(6)=""
+14 ;
+15 SET IBCIMSG(3,"F")="!!"
+16 SET IBCIMSG(5,"F")="!!"
+17 ;
+18 DO EN^DDIOL(.IBCIMSG)
+19 ;
+20 ; Now for the user response
+21 ;
+22 SET DIR(0)="Y"
+23 SET DIR("A")=" Do you wish to proceed"
+24 SET DIR("B")="NO"
+25 DO ^DIR
+26 IF 'Y
SET STOP=1
INTROX ;
+1 QUIT
+2 ;
+3 ;
GETPATH ; This procedure tries to get a valid directory location or path
+1 ; from the user. The file is also opened in this procedure.
+2 ;
+3 NEW IBCIMSG,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,POP
+4 ;
+5 ; Some introductory text for the user
+6 SET IBCIMSG(1)=" The file that will be created is called "_IBCIFILE_"."
+7 SET IBCIMSG(2)=" You may specify a valid directory location (path) for this file."
+8 SET IBCIMSG(3)=" After this file has been created, it needs to be accessible to the"
+9 SET IBCIMSG(4)=" ClaimsManager application. This can be done either through network"
+10 SET IBCIMSG(5)=" connections or by manually moving it to the ClaimsManager server."
+11 SET IBCIMSG(6)=""
+12 ;
+13 SET IBCIMSG(1,"F")="!!"
+14 SET IBCIMSG(2,"F")="!!"
+15 SET IBCIMSG(3,"F")="!!"
+16 ;
+17 DO EN^DDIOL(.IBCIMSG)
+18 ;
+19 ; read user response to directory question
+20 ;
GET1 ;
+1 KILL DIR
+2 SET DIR(0)="FOr"
+3 SET DIR("A")=" Directory"
+4 SET DIR("A",1)=" Please enter the directory location (path) for "_IBCIFILE
+5 SET DIR("A",2)=""
+6 ; retrieves the current directory
SET DIR("B")=$$PWD^%ZISH()
+7 SET DIR("?")=" Enter the location where the file should be created."
+8 SET DIR("?",1)=" Enter the full path specification up to, but not including,"
+9 SET DIR("?",2)=" the filename. This includes any trailing slashes or brackets."
+10 SET DIR("?",3)=" If the operating system allows shortcuts, you can use them."
+11 SET DIR("?",4)=" Examples of valid paths include:"
+12 SET DIR("?",5)=""
+13 SET DIR("?",6)=" DOS/Win c:\scratch\"
+14 SET DIR("?",7)=" UNIX /home/scratch/"
+15 SET DIR("?",8)=" VMS USER$:[SCRATCH]"
+16 SET DIR("?",9)=""
+17 ;
+18 DO ^DIR
+19 ;
+20 ; Process the user response
+21 ;
+22 ; time-out
IF $DATA(DTOUT)
SET STOP=1
GOTO GETPTHX
+23 ; any leading "^" input
IF $DATA(DUOUT)
SET STOP=1
GOTO GETPTHX
+24 ;
+25 ; save the path in the proper variable name
+26 SET IBCIPATH=Y
+27 ;
+28 ; attempt to open the file
+29 DO OPEN^%ZISH(IBCIRTN,IBCIPATH,IBCIFILE,"W")
+30 USE IO(0)
+31 ;
+32 IF POP
Begin DoDot:1
+33 ;
+34 ; This means that the file was not opened.
+35 KILL IBCIMSG
+36 SET IBCIMSG(1)=" """_IBCIPATH_""" is not a valid directory location or path."
+37 SET IBCIMSG(2)=" Please press ""?"" for more assistance."
+38 SET IBCIMSG(3)=""
+39 ;
+40 SET IBCIMSG(1,"F")="!!"
+41 ;
+42 DO EN^DDIOL(.IBCIMSG)
+43 QUIT
End DoDot:1
GOTO GET1
+44 ;
+45 ; At this point, the file has been opened successfully.
+46 ; Display a message about the full file spec and get final confirmation
+47 ;
+48 KILL IBCIMSG,DIR
+49 SET IBCIMSG(1)=" The full file specification including path and filename is:"
+50 SET IBCIMSG(2)=""
+51 SET IBCIMSG(3)=" "_IBCIPATH_IBCIFILE
+52 SET IBCIMSG(4)=""
+53 ;
+54 SET IBCIMSG(1,"F")="!!"
+55 ;
+56 DO EN^DDIOL(.IBCIMSG)
+57 ;
+58 ; Now for the final user confirmation
+59 ;
+60 SET DIR(0)="Y"
+61 SET DIR("A")=" OK to begin"
+62 SET DIR("B")="YES"
+63 DO ^DIR
+64 ;
+65 ; user said NO to begin the extract
IF 'Y
Begin DoDot:1
+66 ; close the file
DO CLOSE^%ZISH(IBCIRTN)
+67 ; write a blank line to the screen
DO EN^DDIOL(" ")
+68 QUIT
End DoDot:1
GOTO GET1
+69 ;
GETPTHX ;
+1 QUIT
+2 ;
+3 ;
+1 ; global.
+2 ;
+3 NEW STARTDT,EVNDT,D0,BILL,STATUS,DFN,D1,PROC,IBCIPROV,IBCIPRDT,HCFA,SSN
+4 NEW TOTBILLS,TOTRECS,DISPMON,DISPYR,MONTH,SAVMONTH,IBCIMSG,X,Y,%H
+5 SET TOTBILLS=0
SET TOTRECS=0
+6 ; initialize scratch global with user/date
KILL ^TMP($JOB,IBCIRTN)
+7 SET %H=$HOROLOG
DO YX^%DTC
+8 SET ^TMP($JOB,IBCIRTN)=DUZ_U_Y
+9 ; write blank line
DO EN^DDIOL(" ")
+10 ; message telling user to wait
DO WAIT^DICD
+11 ; write blank line
DO EN^DDIOL(" ")
+12 ; three years ago
SET STARTDT=DT-30000
+13 SET STARTDT=$ORDER(^DGCR(399,"D",STARTDT),-1)
+14 SET EVNDT=STARTDT
+15 SET SAVMONTH=""
+16 FOR
SET EVNDT=$ORDER(^DGCR(399,"D",EVNDT))
if 'EVNDT
QUIT
Begin DoDot:1
+17 SET MONTH=$EXTRACT(EVNDT,4,5)
+18 IF MONTH'=SAVMONTH
Begin DoDot:2
+19 SET Y=EVNDT
DO DD^%DT
+20 SET DISPMON=$EXTRACT(Y,1,3)
+21 SET DISPYR=$EXTRACT(Y,9,12)
+22 DO EN^DDIOL(" Processing "_DISPMON_" "_DISPYR)
+23 SET SAVMONTH=MONTH
+24 QUIT
End DoDot:2
+25 SET D0=0
+26 FOR
SET D0=$ORDER(^DGCR(399,"D",EVNDT,D0))
if 'D0
QUIT
Begin DoDot:2
+27 SET TOTBILLS=TOTBILLS+1
+28 SET BILL=$GET(^DGCR(399,D0,0))
+29 ; field #.13 STATUS
SET STATUS=$PIECE(BILL,U,13)
+30 IF STATUS=""
QUIT
+31 ; we don't want these
IF $FIND(".1.7.","."_STATUS_".")
QUIT
+32 ; field #.02 PATIENT NAME
SET DFN=$PIECE(BILL,U,2)
+33 ; SSN# of patient
SET SSN=$PIECE($GET(^DPT(DFN,0)),U,9)
+34 IF SSN=""
QUIT
+35 ;
+36 ; esg - 6/8/01
+37 ; Use the new Patch 51 procedures to get the provider data if
+38 ; there is data in the provider multiple.
+39 ; Use the Operating (2), Rendering (3), and Attending (4) providers
+40 ; and get their specialties to build the patient history file.
+41 ;
+42 IF $PIECE($GET(^DGCR(399,D0,"PRV",0)),U,4)
Begin DoDot:3
+43 NEW PRVTYP,IBXARRAY,IBXARRY,IBXDATA,IBXERR,IBPRV
+44 ; use the bill's event date
SET IBCIPRDT=$PIECE(EVNDT,".",1)
+45 IF IBCIPRDT=""
QUIT
+46 ; Patch 51 utility
DO F^IBCEF("N-ALL PROVIDERS",,,D0)
+47 FOR PRVTYP=2,3,4
Begin DoDot:4
+48 SET IBPRV=$PIECE($GET(IBXDATA(PRVTYP,1)),U,3)
+49 SET HCFA=$$BILLSPEC^IBCEU3(D0,IBPRV)
+50 IF HCFA=""
QUIT
+51 ;
+52 ; All the data should be here so file it
+53 ; Update the record counter if we've never seen this
+54 ; patient/specialty pairing before
+55 IF '$DATA(^TMP($JOB,IBCIRTN,SSN,HCFA))
SET TOTRECS=TOTRECS+1
+56 SET ^TMP($JOB,IBCIRTN,SSN,HCFA,IBCIPRDT)=""
+57 QUIT
End DoDot:4
+58 QUIT
End DoDot:3
+59 ;
+60 ; Now loop through the procedures sub-file and extract data
+61 SET D1=0
+62 FOR
SET D1=$ORDER(^DGCR(399,D0,"CP",D1))
if 'D1
QUIT
Begin DoDot:3
+63 SET PROC=$GET(^DGCR(399,D0,"CP",D1,0))
+64 ; field #18 PROVIDER
SET IBCIPROV=$PIECE(PROC,U,18)
+65 IF IBCIPROV=""
QUIT
+66 ; field #1 PROCEDURE DATE
SET IBCIPRDT=$PIECE(PROC,U,2)
+67 IF IBCIPRDT=""
QUIT
+68 ;
+69 ; invoke utility from Kernel patch XU*8.0*132
+70 SET HCFA=$$GET^XUA4A72(IBCIPROV,IBCIPRDT)
+71 ; 2-digit HCFA specialty code
SET HCFA=$PIECE(HCFA,U,8)
+72 IF HCFA=""
QUIT
+73 ;
+74 ; All the data should be here so file it
+75 ; Update the record counter if we've never seen this
+76 ; patient/specialty pairing before
+77 IF '$DATA(^TMP($JOB,IBCIRTN,SSN,HCFA))
SET TOTRECS=TOTRECS+1
+78 SET ^TMP($JOB,IBCIRTN,SSN,HCFA,IBCIPRDT)=""
+79 QUIT
End DoDot:3
+80 QUIT
End DoDot:2
+81 QUIT
End DoDot:1
+82 ;
+83 ;
+84 KILL IBCIMSG
+85 SET IBCIMSG(1)=" The compile process has completed successfully."
+86 SET IBCIMSG(2)=" The number of bills that were reviewed is "_$FNUMBER(TOTBILLS,",")_"."
+87 SET IBCIMSG(3)=" The number of records that will be in the NPT file is "_$FNUMBER(TOTRECS,",")_"."
+88 SET IBCIMSG(4)=" All that's left to do is to copy these records into the NPT file."
+89 SET IBCIMSG(5)=""
+90 ;
+91 SET IBCIMSG(1,"F")="!!"
+92 SET IBCIMSG(2,"F")="!!"
+93 SET IBCIMSG(4,"F")="!!"
+94 ;
+95 DO EN^DDIOL(.IBCIMSG)
+96 ;
EXTRX ;
+1 QUIT
+2 ;
+3 ;
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
+2 ; the most recent date of service for each patient/HCFA specialty
+3 ; code pair. This is why we are not looping through all dates,
+4 ; but doing a $Order with the -1 parameter to get the most recent
+5 ; date. The file is also closed in this procedure and a confirmation
+6 ; message is shown to the user.
+7 ;
+8 NEW SSN,HCFA,DATE,SVCDT,IBCIMSG,POP,X,X1,X2,X3,X4,Y
+9 ;
+10 ; Use the file for writing
+11 USE IO
+12 ;
+13 ; loop through global and output record into file
+14 SET (SSN,HCFA)=""
+15 FOR
SET SSN=$ORDER(^TMP($JOB,IBCIRTN,SSN))
if SSN=""
QUIT
Begin DoDot:1
+16 FOR
SET HCFA=$ORDER(^TMP($JOB,IBCIRTN,SSN,HCFA))
if HCFA=""
QUIT
Begin DoDot:2
+17 SET DATE=$ORDER(^TMP($JOB,IBCIRTN,SSN,HCFA,""),-1)
+18 SET SVCDT=($EXTRACT(DATE,1,3)+1700)_$EXTRACT(DATE,4,7)
+19 ;
+20 ; Output the records to the file
+21 SET X=SSN
SET X1=20
SET X4="T"
WRITE $$FILL^IBCIUT2
+22 SET X=HCFA
SET X1=10
SET X4="T"
WRITE $$FILL^IBCIUT2
+23 SET X=SVCDT
SET X1=17
SET X4="T"
WRITE $$FILL^IBCIUT2
+24 WRITE !
+25 QUIT
End DoDot:2
+26 QUIT
End DoDot:1
+27 ;
+28 ; The file has been created so close it and tell the user
+29 DO CLOSE^%ZISH(IBCIRTN)
+30 USE IO(0)
+31 SET IBCIMSG(1)=" The NPT file creation process is complete!"
+32 SET IBCIMSG(2)=""
+33 SET IBCIMSG(1,"F")="!!"
+34 DO EN^DDIOL(.IBCIMSG)
+35 ;
+36 ; clean up the scratch global
+37 KILL ^TMP($JOB,IBCIRTN)
+38 ;
OUTPUTX ;
+1 QUIT
+2 ;
