ACHSTXCK ; IHS/ITSC/PMF - EXPORT DATA [ 12/06/2002 10:36 AM ]
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**5**;JUN 11, 2001
;IHS/SET/GTH ACHS*3.1*5 12/06/2002 - Keep test routine up to date.
; this is the pre-export check list routine.
; we do a whole series of things to prepare for exporting,
; most of which may cause us to stop.
;
;OUTPUT:
; STOP 0 if not stopping
; 1 if stopping and there is nothing else to do
; 2 if stopping and !!!!!
;
;if this is a 638, ask them if they want to check the data
;if they do, do it and stop
I ACHSF638 S STOP=$$STATCHK I STOP Q
;
;if anybody is fiddling with the POs and has them locked,
; say so and stop
S STOP='$$LOCK^ACHS("^ACHSF(DUZ(2),""D"")","+") I STOP W *7,!! W:$$DIR^XBDIR("E","CHS DATA ENTRY IN PROGRESS -- JOB CANCELLED - <RETURN> TO CONTINUE") "" Q
;
;verify the facility
W !!,"Export data will be made for ",$$LOC^ACHS
S STOP='$$DIR^XBDIR("Y","Is this Correct (Y/N) ","YES","","Export data will be made for "_$$LOC^ACHS,"",2) I $D(DUOUT)!$D(DTOUT) S STOP=1
I STOP Q
;
;if an export file for today already exists,
; tell them so and ask if the y want to continue
I $$EXFILE D S STOP='$$DIR^XBDIR("Y","Continue","N","","","^D HELP^ACHS(""FILEHELP"",""ACHSTX"")",1) I STOP Q
. W !!,*7
. D HELP^ACHS("FILEHELP","ACHSTX")
.Q
;
;if not REEXporting, and export was done today, say so and stop
I 'ACHSREEX,$D(^ACHSTXST("C",DT,DUZ(2))) W !!,"EXPORT PROGRAM ALREADY RUN THIS DATE FOR THIS FACILITY",*7 S STOP=1 Q
;
;fetch the area contracting number and verify it
S ACHSARCO=$P(^ACHSF(DUZ(2),0),U,11)
;I +ACHSARCO<1!($L(ACHSARCO)'=3) U IO(0) W *7,!!,"MISSING AREA CONTRACTING NUMBER - JOB CANCELLED" S STOP=1 Q;IHS/SET/GTH ACHS*3.1*5 12/06/2002
I '(ACHSARCO?3UN) U IO(0) W *7,!!,"Area Contracting Number is not 3 Upper-case Alpha-Numerics",!,"JOB CANCELLED" S STOP=1 Q ;IHS/SET/GTH ACHS*3.1*5 12/06/2002
;
;get the date
S ACHSMDAT=$$DTAO I $D(DUOUT)!$D(DTOUT) S STOP=1 Q
;
;clean up the work globals
D KILLGLBS
;
;get the device for the report
K %ZIS S %ZIS("A")="ENTER OUTPUT REPORT DEVICE # ",%ZIS="P" W !
D ^%ZIS
I POP S STOP=1 Q
;
;if it's a slave printer, set it up
I $D(IO("S")) D SLV^ACHSFU
S ACHSIO=IO
D ^%ZISC,HOME^%ZIS
;
Q
;
KILLGLBS ;EP - Kill unsubscripted work globals.
; ^ACHSDATA( - DHR (REC #2)
; ^ACHSTXPT( - Holds Patients to be exported. (Rec # 3)
; ^ACHSTXVN( - Holds Vendor IENs to be exported. (Rec # 4)
; ^ACHSTXOB( - Holds Document/Transaction to be exported. (Rec # 5)
; ^ACHSTXPD( - Holds Paid Doc info to be exported to Area Office. (Rec # 6)
; ^ACHSTXPG( - Holds Docs with statistical info to be exported to Data Center. (Rec # 7)
;
N ACHS
F ACHS="^ACHSDATA","^ACHSTXPT","^ACHSTXVN","^ACHSTXOB","^ACHSTXPD","^ACHSTXPG" D
. W !,"Resetting ",ACHS,"(0)"
. I $$KILLOK^ZIBGCHAR($P(ACHS,U,2)) W !,$$ERR^ZIBGCHAR($$KILLOK^ZIBGCHAR($P(ACHS,U,2)))
. K @ACHS
. S @(ACHS_"(0)")=""
.Q
Q
;
DTAO() ;EP - Prompt for date sent to Area Office.
Q $$DIR^XBDIR("D^"_DT_":"_$$HTFM^XLFDT($H+5),"ENTER DATE SENT TO AREA OFFICE ","T")
;
STATCHK() ; Check 638 stat data prior to export.
D HELP^ACHSTX7X
I $$DIR^XBDIR("Y","Run pre-export data check first","YES","","","^D HELP^ACHSTX7X",2) D ^ACHSTX7X Q 1
Q 0
;
EXFILE() ; Does export file exist?
NEW X,Y,Z
S Y=$$ASF^ACHS(DUZ(2))
I $$OS^ACHS=2 S Y=$E(Y,3,6)
S Y="ACHS"_Y_"."_$$JDT^ACHS(DT)
I $$LIST^%ZISH($$EX^ACHS,Y,.X)
S Z=""
F S Z=$O(X(Z)) Q:'Z I X(Z)=Y Q
Q $S('Z:0,1:1)
;
FILEHELP ;EP - ?? help text, from ACHS via DIR.
;;
;; *** AN EXPORT FILE FOR TODAY ALREADY EXISTS ***
;;
;;An export file already exists in your export directory for today.
;;You will overwrite the file if you continue. If the file was
;;correctly generated, the data in the file will be lost. If you
;;are certain that the data in the file was incorrectly generated,
;;then proceed, forewarned.
;;
;;###
ACHSTXCK ; IHS/ITSC/PMF - EXPORT DATA [ 12/06/2002 10:36 AM ]
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**5**;JUN 11, 2001
+2 ;IHS/SET/GTH ACHS*3.1*5 12/06/2002 - Keep test routine up to date.
+3 ; this is the pre-export check list routine.
+4 ; we do a whole series of things to prepare for exporting,
+5 ; most of which may cause us to stop.
+6 ;
+7 ;OUTPUT:
+8 ; STOP 0 if not stopping
+9 ; 1 if stopping and there is nothing else to do
+10 ; 2 if stopping and !!!!!
+11 ;
+12 ;if this is a 638, ask them if they want to check the data
+13 ;if they do, do it and stop
+14 IF ACHSF638
SET STOP=$$STATCHK
IF STOP
QUIT
+15 ;
+16 ;if anybody is fiddling with the POs and has them locked,
+17 ; say so and stop
+18 SET STOP='$$LOCK^ACHS("^ACHSF(DUZ(2),""D"")","+")
IF STOP
WRITE *7,!!
IF $$DIR^XBDIR("E","CHS DATA ENTRY IN PROGRESS -- JOB CANCELLED - <RETURN> TO CONTINUE")
WRITE ""
QUIT
+19 ;
+20 ;verify the facility
+21 WRITE !!,"Export data will be made for ",$$LOC^ACHS
+22 SET STOP='$$DIR^XBDIR("Y","Is this Correct (Y/N) ","YES","","Export data will be made for "_$$LOC^ACHS,"",2)
IF $DATA(DUOUT)!$DATA(DTOUT)
SET STOP=1
+23 IF STOP
QUIT
+24 ;
+25 ;if an export file for today already exists,
+26 ; tell them so and ask if the y want to continue
+27 IF $$EXFILE
Begin DoDot:1
+28 WRITE !!,*7
+29 DO HELP^ACHS("FILEHELP","ACHSTX")
+30 QUIT
End DoDot:1
SET STOP='$$DIR^XBDIR("Y","Continue","N","","","^D HELP^ACHS(""FILEHELP"",""ACHSTX"")",1)
IF STOP
QUIT
+31 ;
+32 ;if not REEXporting, and export was done today, say so and stop
+33 IF 'ACHSREEX
IF $DATA(^ACHSTXST("C",DT,DUZ(2)))
WRITE !!,"EXPORT PROGRAM ALREADY RUN THIS DATE FOR THIS FACILITY",*7
SET STOP=1
QUIT
+34 ;
+35 ;fetch the area contracting number and verify it
+36 SET ACHSARCO=$PIECE(^ACHSF(DUZ(2),0),U,11)
+37 ;I +ACHSARCO<1!($L(ACHSARCO)'=3) U IO(0) W *7,!!,"MISSING AREA CONTRACTING NUMBER - JOB CANCELLED" S STOP=1 Q;IHS/SET/GTH ACHS*3.1*5 12/06/2002
+38 ;IHS/SET/GTH ACHS*3.1*5 12/06/2002
IF '(ACHSARCO?3UN)
USE IO(0)
WRITE *7,!!,"Area Contracting Number is not 3 Upper-case Alpha-Numerics",!,"JOB CANCELLED"
SET STOP=1
QUIT
+39 ;
+40 ;get the date
+41 SET ACHSMDAT=$$DTAO
IF $DATA(DUOUT)!$DATA(DTOUT)
SET STOP=1
QUIT
+42 ;
+43 ;clean up the work globals
+44 DO KILLGLBS
+45 ;
+46 ;get the device for the report
+47 KILL %ZIS
SET %ZIS("A")="ENTER OUTPUT REPORT DEVICE # "
SET %ZIS="P"
WRITE !
+48 DO ^%ZIS
+49 IF POP
SET STOP=1
QUIT
+50 ;
+51 ;if it's a slave printer, set it up
+52 IF $DATA(IO("S"))
DO SLV^ACHSFU
+53 SET ACHSIO=IO
+54 DO ^%ZISC
DO HOME^%ZIS
+55 ;
+56 QUIT
+57 ;
KILLGLBS ;EP - Kill unsubscripted work globals.
+1 ; ^ACHSDATA( - DHR (REC #2)
+2 ; ^ACHSTXPT( - Holds Patients to be exported. (Rec # 3)
+3 ; ^ACHSTXVN( - Holds Vendor IENs to be exported. (Rec # 4)
+4 ; ^ACHSTXOB( - Holds Document/Transaction to be exported. (Rec # 5)
+5 ; ^ACHSTXPD( - Holds Paid Doc info to be exported to Area Office. (Rec # 6)
+6 ; ^ACHSTXPG( - Holds Docs with statistical info to be exported to Data Center. (Rec # 7)
+7 ;
+8 NEW ACHS
+9 FOR ACHS="^ACHSDATA","^ACHSTXPT","^ACHSTXVN","^ACHSTXOB","^ACHSTXPD","^ACHSTXPG"
Begin DoDot:1
+10 WRITE !,"Resetting ",ACHS,"(0)"
+11 IF $$KILLOK^ZIBGCHAR($PIECE(ACHS,U,2))
WRITE !,$$ERR^ZIBGCHAR($$KILLOK^ZIBGCHAR($PIECE(ACHS,U,2)))
+12 KILL @ACHS
+13 SET @(ACHS_"(0)")=""
+14 QUIT
End DoDot:1
+15 QUIT
+16 ;
DTAO() ;EP - Prompt for date sent to Area Office.
+1 QUIT $$DIR^XBDIR("D^"_DT_":"_$$HTFM^XLFDT($HOROLOG+5),"ENTER DATE SENT TO AREA OFFICE ","T")
+2 ;
STATCHK() ; Check 638 stat data prior to export.
+1 DO HELP^ACHSTX7X
+2 IF $$DIR^XBDIR("Y","Run pre-export data check first","YES","","","^D HELP^ACHSTX7X",2)
DO ^ACHSTX7X
QUIT 1
+3 QUIT 0
+4 ;
EXFILE() ; Does export file exist?
+1 NEW X,Y,Z
+2 SET Y=$$ASF^ACHS(DUZ(2))
+3 IF $$OS^ACHS=2
SET Y=$EXTRACT(Y,3,6)
+4 SET Y="ACHS"_Y_"."_$$JDT^ACHS(DT)
+5 IF $$LIST^%ZISH($$EX^ACHS,Y,.X)
+6 SET Z=""
+7 FOR
SET Z=$ORDER(X(Z))
IF 'Z
QUIT
IF X(Z)=Y
QUIT
+8 QUIT $SELECT('Z:0,1:1)
+9 ;
FILEHELP ;EP - ?? help text, from ACHS via DIR.
+1 ;;
+2 ;; *** AN EXPORT FILE FOR TODAY ALREADY EXISTS ***
+3 ;;
+4 ;;An export file already exists in your export directory for today.
+5 ;;You will overwrite the file if you continue. If the file was
+6 ;;correctly generated, the data in the file will be lost. If you
+7 ;;are certain that the data in the file was incorrectly generated,
+8 ;;then proceed, forewarned.
+9 ;;
+10 ;;###
