BTIUUPL ; IHS/ITSC/LJF - ASCII Upload ;
;;1.0;TEXT INTEGRATION UTILITIES;**1002**;NOV 04, 2004
; IHS copy of TIUUPLD for silent ASCII upload
; -- see tagged lines for changes
;IHS/OIT/LJF 3/18/2005 PATCH 1002 if line too long, break it up using FM call
;
MAIN ;EP; Control branching
Q:$$GET1^DIQ(9003130.2,1,.02)]"" ;do NOT start upload if one already running
D SET(.02,$$NOW^XLFDT) ;set start time for upload
D ^XBKVAR ;added so call from unix works
NEW TIUZMSG ;used for silent messaging
N EOM,TIUDA,TIUERR,TIUHDR,TIULN,TIUSRC,X
I '$D(TIUPRM0)!'$D(TIUPRM1) D SETPARM^TIULE
S TIUSRC=$P($G(TIUPRM0),U,9),EOM=$P($G(TIUPRM0),U,11)
;I EOM']"",($P(TIUPRM0,U,17)'="k") W !,$C(7),$C(7),$C(7),"No End of Message Signal Defined - Contact IRM.",! Q ;original VA
I EOM']"",($P(TIUPRM0,U,17)'="k") D SET(.05,"No End of Message Signal Defined - Contact IRM.") Q ;store error message
S:TIUSRC']"" TIUSRC="R"
S TIUHDR=$P(TIUPRM0,U,10)
;I TIUHDR']"" W $C(7),$C(7),$C(7),"No Record Header Signal Defined - Contact IRM.",! Q ;original VA
I TIUHDR']"" D SET(.05,"No Record Header Signal Defined - Contact IRM.") Q ;store error message
S TIUDA=$$MAKEBUF
;I +TIUDA'>0 W $C(7),$C(7),$C(7),"Unable to create a Buffer File Record - Contact IRM.",! Q ;original VA
I +TIUDA'>0 D SET(.05,"Unable to create a Buffer File Record - Contact IRM.") Q ;store error message
I TIUSRC="R" D REMOTE(TIUDA)
I TIUSRC="H" D HFS(TIUDA)
;I +$G(TIUERR) W $C(7),$C(7),$C(7),!,"Kermit Error: ",$G(TIUERR)," Please re-transmit the file...",! ;original VA
I +$G(TIUERR) D SET(.05,"Kermit Error: "_$G(TIUERR)_" Please re-transmit the file...") Q ;store error message
; Set $ZB to MAIN+14^TIUUPLD:2
I +$O(^TIU(8925.2,TIUDA,"TEXT",0))>0,'+$G(TIUERR) D FILE(TIUDA)
I +$O(^TIU(8925.2,TIUDA,"TEXT",0))'>0!+$G(TIUERR) D BUFPURGE^TIUPUTC(TIUDA)
D SET(.02,"@") ;upload done - okay to spawn new job
Q
REMOTE(DA) ; Read ASCII stream from remote computer
N TIUI,TIUPAC,X
I '$D(TIUPRM0)!'$D(TIUPRM1) D SETPARM^TIULE
S TIUPAC=$P(TIUPRM0,U,15)
;I TIUPAC']"",($P(TIUPRM0,U,17)'="k") W $C(7),$C(7),$C(7),"No Pace Character Defined - Contact IRM.",! Q ;original VA
I TIUPAC']"",($P(TIUPRM0,U,17)'="k") D SET(.05,"No Pace Character Defined - Contact IRM.") Q ;store error message
I $P(TIUPRM0,U,17)="k" D KERMIT(DA) Q
D REMHDR("ASCII")
F R X:DTIME Q:'$T!(X=EOM)!(X="^")!(X="^^") D
. I X?1."?" D HELP(X),REMHDR("ASCII") Q
. ; Ignore leading white space
. I (+$O(^TIU(8925.2,DA,"TEXT",0))'>0),(X="") Q
. S TIUI=+$G(TIUI)+1,^TIU(8925.2,DA,"TEXT",TIUI,0)=$$STRIP(X)
. W !,$C(TIUPAC) ; Send ACK to remote
S ^TIU(8925.2,DA,"TEXT",0)="^^"_$G(TIUI)_"^"_$G(TIUI)_"^"_DT_"^^^^"
Q
REMHDR(PRTCL) ; Write Header for Remote upload
W @IOF D JUSTIFY^TIUU($$TITLE^TIUU(PRTCL_" UPLOAD"),"C")
W:PRTCL="ASCII" !!,"Initiate upload procedure:",!
Q
KERMIT(DA) ; Use Kermit Protocol Driver
N XTKDIC,XTKERR,XTKMODE,DWLC
D REMHDR("KERMIT")
S XTKDIC="^TIU(8925.2,"_+DA_",""TEXT"",",XTKMODE=2
D RECEIVE^XTKERMIT I +$G(XTKERR) S TIUERR=$G(XTKERR) W !
Q
HFS(DA) ; Read HFS file
N TIUI,X
I '$D(TIUPRM0)!'$D(TIUPRM1) D SETPARM^TIULE
;W @IOF D JUSTIFY^TIUU($$TITLE^TIUU("ASCII UPLOAD"),"C") ;original VA
;W !!,"Select Host File:",! D ^%ZIS I POP W !,$C(7),"Device unavailable." Q ;original VA
;
NEW TIUSITE S TIUSITE=$O(^TIU(8925.99,"B",DUZ(2),0)) ;added - find site
I 'TIUSITE D SET(.05,"Site not setup in Parameter File") Q ;added - store error and quit
S IOP="HFS",%ZIS("HFSNAME")=$$GET1^DIQ(8925.99,TIUSITE,9999999.01) ;added - find directory
S %ZIS("HFSNAME")=%ZIS("HFSNAME")_$$GET1^DIQ(8925.99,TIUSITE,9999999.03) ;added - find filename
S %ZIS("HFSMODE")="R" D ^%ZIS ;added - is it there?
I POP D SET(.03,$$NOW^XLFDT) Q ;added - if no file, update status global & quit
H 5 ;added wait in case ftp in process at call time
S IOP="HFS",%ZIS("HFSNAME")=$$GET1^DIQ(8925.99,TIUSITE,9999999.01) ;added - find directory
S %ZIS("HFSNAME")=%ZIS("HFSNAME")_$$GET1^DIQ(8925.99,TIUSITE,9999999.03) ;added - find filename
S %ZIS("HFSMODE")="RW" D ^%ZIS ;added - open of uploading now
I POP D SET(.05,"Device Unavailable") Q ;added - store error and quit
;
;F U IO R X:DTIME Q:'$T!(X=EOM)!(X="^")!(X="^^") D ;original VA
NEW QUIT S QUIT=0 F U IO R X:1 Q:QUIT=1 D ;changed DTIME per Dimitri
. I X=EOM S QUIT=1 Q
. ;
. ;IHS/OIT/LJF 3/18/2005 PATCH 1002 if line too long, break it up
. ;I $L(X)>255 S X=$$REPEAT^XLFSTR("?",75) ;if line too long, reset to 75? - may be garbage
. I $L(X)>255 D Q
. . NEW I K ^UTILITY($J,"W")
. . S DIWL=1,DIWR=75,DIWF="I" D ^DIWP
. . F I=1:1 Q:'$D(^UTILITY($J,"W",1,I)) S TIUI=+$G(TIUI)+1,^TIU(8925.2,DA,"TEXT",TIUI,0)=$$STRIP(^UTILITY($J,"W",1,I,0))
. . K ^UTILITY($J,"W")
. . ;IHS/OIT/LJF 3/18/2005 PATCH 1002 end of new code
. ;
. S TIUI=+$G(TIUI)+1,^TIU(8925.2,DA,"TEXT",TIUI,0)=$$STRIP(X)
;
S ^TIU(8925.2,DA,"TEXT",0)="^^"_$G(TIUI)_"^"_$G(TIUI)_"^"_DT_"^^^^"
D ^%ZISC
;
D SET(.04,$$NOW^XLFDT) ;added - update status global for date last file processed
D ^BTIUARC ;added - move to archive directory
;
Q
STRIP(X) ; Strip control characters
N I,Y
; First replace TABS w/5 spaces
F I=1:1:$L(X) S:$A(X,I)=9 X=$E(X,1,(I-1))_" "_$E(X,(I+1),$L(X))
; Next, remove control characters
S Y="" F I=1:1:$L(X) S:$A(X,I)>31 Y=Y_$E(X,I)
Q Y
MAKEBUF() ; Subroutine to create buffer records
N DIC,DA,DR,DIE,START,X,Y
S START=$$NOW^TIULC
S (DIC,DLAYGO)=8925.2,DIC(0)="LX",X=""""_$J_"""" D ^DIC
I +Y'>0 S DA=Y G MAKEBUX
S DA=+Y,DIE=DIC,DR=".02////"_+$G(DUZ)_";.03////"_START D ^DIE
MAKEBUX Q DA
FILE(DA) ; Completes upload transaction, invokes filer/router
N DIE,DR
I '$D(^TIU(8925.2,+DA,0)) G FILEX
S DIE="^TIU(8925.2,",DR=".04////"_$$NOW^TIULC D ^DIE
; Task background filer/router to process buffer record
S ZTIO="",ZTDTH=$H,ZTSAVE("DA")=""
S ZTRTN=$S($P(TIUPRM0,U,16)="D":"MAIN^TIUPUTD",1:"MAIN^TIUPUTC")
S ZTDESC="TIU Document Filer"
; If filer is NOT designated to run in the foreground, queue it
I '+$P(TIUPRM0,U,18) D G FILEX
. D ^%ZTLOAD
. ;W !,$S($D(ZTSK):"Filer/Router Queued!",1:"Filer/Router Cancelled!") ;original VA - need silence
; Otherwise, run the filer in the foreground
D @ZTRTN
FILEX Q
HELP(X) ; Process HELP for Remote upload
I X="?" W !?3,"Begin file transfer using ASCII protocol upload procedure.",!
I X?2."?" D
. W !?3,"Consult your terminal emulator's User Manual to determine",!
. W !?3,"how to set-up and initiate an ASCII protocol file transfer.",!
W !?3,"Enter '^' or '^^' to exit.",!
S TIUX=$$READ^TIUU("FOA","Press RETURN to continue...")
Q
;
SET(FIELD,ANS) ; upload BTIU UPLOAD STATUS file
NEW DIE,DA,DR
S DIE=9003130.2,DA=1,DR=FIELD_"///"_ANS
D ^DIE
Q
;
DISPLAY ;EP; -- display status of upload
NEW X,Y
D ^XBCLS D MSG^BTIUU("**STATUS OF TIU UPLOAD**",2,1,0)
;
S Y=$$GET1^DIQ(9003130.2,1,.04,"I")
S X=$S(Y="":"NO FILES UPLOADED",1:$$DOW^XLFDT(Y)_" "_$$FMTE^XLFDT(Y))
D MSG^BTIUU("LAST FILE UPLOADED INTO RPMS: "_X,1,1,0)
;
S Y=$$GET1^DIQ(9003130.2,1,.03,"I")
S X=$S(Y="":"NO LAST SCAN FOUND",1:$$DOW^XLFDT(Y)_" "_$$FMTE^XLFDT(Y))
D MSG^BTIUU("LAST SCAN FOR NEW TIU FILE: "_X,1,1,0)
;
S Y=$$GET1^DIQ(9003130.2,1,.02) I Y]"" D
. D MSG^BTIUU("UPLOAD STILL RUNNING; CHECK END OF FILE MARKERS",1,0,0)
. D MSG^BTIUU("UPLOAD STARTED ON "_Y,1,0,0)
. S X=$$GET1^DIQ(900903130.2,1,.05)
. I X]"" D MSG^BTIUU("ERROR RECORDED: "_X,1,1,0)
D RETURN^BTIUU
Q
;
RESET ;EP; resets Upload Running and Error Messages back to null so uplaod can run
; after porblem has been fixed; run this to restart upload
Q:'$$READ^TIUU("Y","OKAY to Reset UPLOAD STATUS","NO")
NEW DIE,DA,DR
S DIE=9003130.2,DA=1,DR=".02///@;.05///@"
D ^DIE
Q
BTIUUPL ; IHS/ITSC/LJF - ASCII Upload ;
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**1002**;NOV 04, 2004
+2 ; IHS copy of TIUUPLD for silent ASCII upload
+3 ; -- see tagged lines for changes
+4 ;IHS/OIT/LJF 3/18/2005 PATCH 1002 if line too long, break it up using FM call
+5 ;
MAIN ;EP; Control branching
+1 ;do NOT start upload if one already running
IF $$GET1^DIQ(9003130.2,1,.02)]""
QUIT
+2 ;set start time for upload
DO SET(.02,$$NOW^XLFDT)
+3 ;added so call from unix works
DO ^XBKVAR
+4 ;used for silent messaging
NEW TIUZMSG
+5 NEW EOM,TIUDA,TIUERR,TIUHDR,TIULN,TIUSRC,X
+6 IF '$DATA(TIUPRM0)!'$DATA(TIUPRM1)
DO SETPARM^TIULE
+7 SET TIUSRC=$PIECE($GET(TIUPRM0),U,9)
SET EOM=$PIECE($GET(TIUPRM0),U,11)
+8 ;I EOM']"",($P(TIUPRM0,U,17)'="k") W !,$C(7),$C(7),$C(7),"No End of Message Signal Defined - Contact IRM.",! Q ;original VA
+9 ;store error message
IF EOM']""
IF ($PIECE(TIUPRM0,U,17)'="k")
DO SET(.05,"No End of Message Signal Defined - Contact IRM.")
QUIT
+10 IF TIUSRC']""
SET TIUSRC="R"
+11 SET TIUHDR=$PIECE(TIUPRM0,U,10)
+12 ;I TIUHDR']"" W $C(7),$C(7),$C(7),"No Record Header Signal Defined - Contact IRM.",! Q ;original VA
+13 ;store error message
IF TIUHDR']""
DO SET(.05,"No Record Header Signal Defined - Contact IRM.")
QUIT
+14 SET TIUDA=$$MAKEBUF
+15 ;I +TIUDA'>0 W $C(7),$C(7),$C(7),"Unable to create a Buffer File Record - Contact IRM.",! Q ;original VA
+16 ;store error message
IF +TIUDA'>0
DO SET(.05,"Unable to create a Buffer File Record - Contact IRM.")
QUIT
+17 IF TIUSRC="R"
DO REMOTE(TIUDA)
+18 IF TIUSRC="H"
DO HFS(TIUDA)
+19 ;I +$G(TIUERR) W $C(7),$C(7),$C(7),!,"Kermit Error: ",$G(TIUERR)," Please re-transmit the file...",! ;original VA
+20 ;store error message
IF +$GET(TIUERR)
DO SET(.05,"Kermit Error: "_$GET(TIUERR)_" Please re-transmit the file...")
QUIT
+21 ; Set $ZB to MAIN+14^TIUUPLD:2
+22 IF +$ORDER(^TIU(8925.2,TIUDA,"TEXT",0))>0
IF '+$GET(TIUERR)
DO FILE(TIUDA)
+23 IF +$ORDER(^TIU(8925.2,TIUDA,"TEXT",0))'>0!+$GET(TIUERR)
DO BUFPURGE^TIUPUTC(TIUDA)
+24 ;upload done - okay to spawn new job
DO SET(.02,"@")
+25 QUIT
REMOTE(DA) ; Read ASCII stream from remote computer
+1 NEW TIUI,TIUPAC,X
+2 IF '$DATA(TIUPRM0)!'$DATA(TIUPRM1)
DO SETPARM^TIULE
+3 SET TIUPAC=$PIECE(TIUPRM0,U,15)
+4 ;I TIUPAC']"",($P(TIUPRM0,U,17)'="k") W $C(7),$C(7),$C(7),"No Pace Character Defined - Contact IRM.",! Q ;original VA
+5 ;store error message
IF TIUPAC']""
IF ($PIECE(TIUPRM0,U,17)'="k")
DO SET(.05,"No Pace Character Defined - Contact IRM.")
QUIT
+6 IF $PIECE(TIUPRM0,U,17)="k"
DO KERMIT(DA)
QUIT
+7 DO REMHDR("ASCII")
+8 FOR
READ X:DTIME
IF '$TEST!(X=EOM)!(X="^")!(X="^^")
QUIT
Begin DoDot:1
+9 IF X?1."?"
DO HELP(X)
DO REMHDR("ASCII")
QUIT
+10 ; Ignore leading white space
+11 IF (+$ORDER(^TIU(8925.2,DA,"TEXT",0))'>0)
IF (X="")
QUIT
+12 SET TIUI=+$GET(TIUI)+1
SET ^TIU(8925.2,DA,"TEXT",TIUI,0)=$$STRIP(X)
+13 ; Send ACK to remote
WRITE !,$CHAR(TIUPAC)
End DoDot:1
+14 SET ^TIU(8925.2,DA,"TEXT",0)="^^"_$GET(TIUI)_"^"_$GET(TIUI)_"^"_DT_"^^^^"
+15 QUIT
REMHDR(PRTCL) ; Write Header for Remote upload
+1 WRITE @IOF
DO JUSTIFY^TIUU($$TITLE^TIUU(PRTCL_" UPLOAD"),"C")
+2 IF PRTCL="ASCII"
WRITE !!,"Initiate upload procedure:",!
+3 QUIT
KERMIT(DA) ; Use Kermit Protocol Driver
+1 NEW XTKDIC,XTKERR,XTKMODE,DWLC
+2 DO REMHDR("KERMIT")
+3 SET XTKDIC="^TIU(8925.2,"_+DA_",""TEXT"","
SET XTKMODE=2
+4 DO RECEIVE^XTKERMIT
IF +$GET(XTKERR)
SET TIUERR=$GET(XTKERR)
WRITE !
+5 QUIT
HFS(DA) ; Read HFS file
+1 NEW TIUI,X
+2 IF '$DATA(TIUPRM0)!'$DATA(TIUPRM1)
DO SETPARM^TIULE
+3 ;W @IOF D JUSTIFY^TIUU($$TITLE^TIUU("ASCII UPLOAD"),"C") ;original VA
+4 ;W !!,"Select Host File:",! D ^%ZIS I POP W !,$C(7),"Device unavailable." Q ;original VA
+5 ;
+6 ;added - find site
NEW TIUSITE
SET TIUSITE=$ORDER(^TIU(8925.99,"B",DUZ(2),0))
+7 ;added - store error and quit
IF 'TIUSITE
DO SET(.05,"Site not setup in Parameter File")
QUIT
+8 ;added - find directory
SET IOP="HFS"
SET %ZIS("HFSNAME")=$$GET1^DIQ(8925.99,TIUSITE,9999999.01)
+9 ;added - find filename
SET %ZIS("HFSNAME")=%ZIS("HFSNAME")_$$GET1^DIQ(8925.99,TIUSITE,9999999.03)
+10 ;added - is it there?
SET %ZIS("HFSMODE")="R"
DO ^%ZIS
+11 ;added - if no file, update status global & quit
IF POP
DO SET(.03,$$NOW^XLFDT)
QUIT
+12 ;added wait in case ftp in process at call time
HANG 5
+13 ;added - find directory
SET IOP="HFS"
SET %ZIS("HFSNAME")=$$GET1^DIQ(8925.99,TIUSITE,9999999.01)
+14 ;added - find filename
SET %ZIS("HFSNAME")=%ZIS("HFSNAME")_$$GET1^DIQ(8925.99,TIUSITE,9999999.03)
+15 ;added - open of uploading now
SET %ZIS("HFSMODE")="RW"
DO ^%ZIS
+16 ;added - store error and quit
IF POP
DO SET(.05,"Device Unavailable")
QUIT
+17 ;
+18 ;F U IO R X:DTIME Q:'$T!(X=EOM)!(X="^")!(X="^^") D ;original VA
+19 ;changed DTIME per Dimitri
NEW QUIT
SET QUIT=0
FOR
USE IO
READ X:1
IF QUIT=1
QUIT
Begin DoDot:1
+20 IF X=EOM
SET QUIT=1
QUIT
+21 ;
+22 ;IHS/OIT/LJF 3/18/2005 PATCH 1002 if line too long, break it up
+23 ;I $L(X)>255 S X=$$REPEAT^XLFSTR("?",75) ;if line too long, reset to 75? - may be garbage
+24 IF $LENGTH(X)>255
Begin DoDot:2
+25 NEW I
KILL ^UTILITY($JOB,"W")
+26 SET DIWL=1
SET DIWR=75
SET DIWF="I"
DO ^DIWP
+27 FOR I=1:1
IF '$DATA(^UTILITY($JOB,"W",1,I))
QUIT
SET TIUI=+$GET(TIUI)+1
SET ^TIU(8925.2,DA,"TEXT",TIUI,0)=$$STRIP(^UTILITY($JOB,"W",1,I,0))
+28 KILL ^UTILITY($JOB,"W")
+29 ;IHS/OIT/LJF 3/18/2005 PATCH 1002 end of new code
End DoDot:2
QUIT
+30 ;
+31 SET TIUI=+$GET(TIUI)+1
SET ^TIU(8925.2,DA,"TEXT",TIUI,0)=$$STRIP(X)
End DoDot:1
+32 ;
+33 SET ^TIU(8925.2,DA,"TEXT",0)="^^"_$GET(TIUI)_"^"_$GET(TIUI)_"^"_DT_"^^^^"
+34 DO ^%ZISC
+35 ;
+36 ;added - update status global for date last file processed
DO SET(.04,$$NOW^XLFDT)
+37 ;added - move to archive directory
DO ^BTIUARC
+38 ;
+39 QUIT
STRIP(X) ; Strip control characters
+1 NEW I,Y
+2 ; First replace TABS w/5 spaces
+3 FOR I=1:1:$LENGTH(X)
IF $ASCII(X,I)=9
SET X=$EXTRACT(X,1,(I-1))_" "_$EXTRACT(X,(I+1),$LENGTH(X))
+4 ; Next, remove control characters
+5 SET Y=""
FOR I=1:1:$LENGTH(X)
IF $ASCII(X,I)>31
SET Y=Y_$EXTRACT(X,I)
+6 QUIT Y
MAKEBUF() ; Subroutine to create buffer records
+1 NEW DIC,DA,DR,DIE,START,X,Y
+2 SET START=$$NOW^TIULC
+3 SET (DIC,DLAYGO)=8925.2
SET DIC(0)="LX"
SET X=""""_$JOB_""""
DO ^DIC
+4 IF +Y'>0
SET DA=Y
GOTO MAKEBUX
+5 SET DA=+Y
SET DIE=DIC
SET DR=".02////"_+$GET(DUZ)_";.03////"_START
DO ^DIE
MAKEBUX QUIT DA
FILE(DA) ; Completes upload transaction, invokes filer/router
+1 NEW DIE,DR
+2 IF '$DATA(^TIU(8925.2,+DA,0))
GOTO FILEX
+3 SET DIE="^TIU(8925.2,"
SET DR=".04////"_$$NOW^TIULC
DO ^DIE
+4 ; Task background filer/router to process buffer record
+5 SET ZTIO=""
SET ZTDTH=$HOROLOG
SET ZTSAVE("DA")=""
+6 SET ZTRTN=$SELECT($PIECE(TIUPRM0,U,16)="D":"MAIN^TIUPUTD",1:"MAIN^TIUPUTC")
+7 SET ZTDESC="TIU Document Filer"
+8 ; If filer is NOT designated to run in the foreground, queue it
+9 IF '+$PIECE(TIUPRM0,U,18)
Begin DoDot:1
+10 DO ^%ZTLOAD
+11 ;W !,$S($D(ZTSK):"Filer/Router Queued!",1:"Filer/Router Cancelled!") ;original VA - need silence
End DoDot:1
GOTO FILEX
+12 ; Otherwise, run the filer in the foreground
+13 DO @ZTRTN
FILEX QUIT
HELP(X) ; Process HELP for Remote upload
+1 IF X="?"
WRITE !?3,"Begin file transfer using ASCII protocol upload procedure.",!
+2 IF X?2."?"
Begin DoDot:1
+3 WRITE !?3,"Consult your terminal emulator's User Manual to determine",!
+4 WRITE !?3,"how to set-up and initiate an ASCII protocol file transfer.",!
End DoDot:1
+5 WRITE !?3,"Enter '^' or '^^' to exit.",!
+6 SET TIUX=$$READ^TIUU("FOA","Press RETURN to continue...")
+7 QUIT
+8 ;
SET(FIELD,ANS) ; upload BTIU UPLOAD STATUS file
+1 NEW DIE,DA,DR
+2 SET DIE=9003130.2
SET DA=1
SET DR=FIELD_"///"_ANS
+3 DO ^DIE
+4 QUIT
+5 ;
DISPLAY ;EP; -- display status of upload
+1 NEW X,Y
+2 DO ^XBCLS
DO MSG^BTIUU("**STATUS OF TIU UPLOAD**",2,1,0)
+3 ;
+4 SET Y=$$GET1^DIQ(9003130.2,1,.04,"I")
+5 SET X=$SELECT(Y="":"NO FILES UPLOADED",1:$$DOW^XLFDT(Y)_" "_$$FMTE^XLFDT(Y))
+6 DO MSG^BTIUU("LAST FILE UPLOADED INTO RPMS: "_X,1,1,0)
+7 ;
+8 SET Y=$$GET1^DIQ(9003130.2,1,.03,"I")
+9 SET X=$SELECT(Y="":"NO LAST SCAN FOUND",1:$$DOW^XLFDT(Y)_" "_$$FMTE^XLFDT(Y))
+10 DO MSG^BTIUU("LAST SCAN FOR NEW TIU FILE: "_X,1,1,0)
+11 ;
+12 SET Y=$$GET1^DIQ(9003130.2,1,.02)
IF Y]""
Begin DoDot:1
+13 DO MSG^BTIUU("UPLOAD STILL RUNNING; CHECK END OF FILE MARKERS",1,0,0)
+14 DO MSG^BTIUU("UPLOAD STARTED ON "_Y,1,0,0)
+15 SET X=$$GET1^DIQ(900903130.2,1,.05)
+16 IF X]""
DO MSG^BTIUU("ERROR RECORDED: "_X,1,1,0)
End DoDot:1
+17 DO RETURN^BTIUU
+18 QUIT
+19 ;
RESET ;EP; resets Upload Running and Error Messages back to null so uplaod can run
+1 ; after porblem has been fixed; run this to restart upload
+2 IF '$$READ^TIUU("Y","OKAY to Reset UPLOAD STATUS","NO")
QUIT
+3 NEW DIE,DA,DR
+4 SET DIE=9003130.2
SET DA=1
SET DR=".02///@;.05///@"
+5 DO ^DIE
+6 QUIT
