- 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