| [613] | 1 | TIUUPLD ; SLC/JER - ASCII Upload ;9/11/98@16:39:47
|
|---|
| 2 | ;;1.0;TEXT INTEGRATION UTILITIES;**21**;Jun 20, 1997
|
|---|
| 3 | MAIN ; Control branching
|
|---|
| 4 | N EOM,TIUDA,TIUERR,TIUHDR,TIULN,TIUSRC,X
|
|---|
| 5 | I '$D(TIUPRM0)!'$D(TIUPRM1) D SETPARM^TIULE
|
|---|
| 6 | S TIUSRC=$P($G(TIUPRM0),U,9),EOM=$P($G(TIUPRM0),U,11)
|
|---|
| 7 | I EOM']"",($P(TIUPRM0,U,17)'="k") W !,$C(7),$C(7),$C(7),"No End of Message Signal Defined - Contact IRM.",! Q
|
|---|
| 8 | S:TIUSRC']"" TIUSRC="R"
|
|---|
| 9 | S TIUHDR=$P(TIUPRM0,U,10)
|
|---|
| 10 | I TIUHDR']"" W $C(7),$C(7),$C(7),"No Record Header Signal Defined - Contact IRM.",! Q
|
|---|
| 11 | S TIUDA=$$MAKEBUF
|
|---|
| 12 | I +TIUDA'>0 W $C(7),$C(7),$C(7),"Unable to create a Buffer File Record - Contact IRM.",! Q
|
|---|
| 13 | I TIUSRC="R" D REMOTE(TIUDA)
|
|---|
| 14 | I TIUSRC="H" D HFS(TIUDA)
|
|---|
| 15 | I +$G(TIUERR) W $C(7),$C(7),$C(7),!,"File Transfer Error: ",$G(TIUERR),!!,"Please re-transmit the file...",!
|
|---|
| 16 | ; Set $ZB to MAIN+14^TIUUPLD:2
|
|---|
| 17 | I +$O(^TIU(8925.2,TIUDA,"TEXT",0))>0,'+$G(TIUERR) D FILE(TIUDA)
|
|---|
| 18 | I +$O(^TIU(8925.2,TIUDA,"TEXT",0))'>0!+$G(TIUERR) D BUFPURGE^TIUPUTC(TIUDA)
|
|---|
| 19 | Q
|
|---|
| 20 | REMOTE(DA) ; Read ASCII stream from remote computer
|
|---|
| 21 | N TIUI,TIUPAC,X
|
|---|
| 22 | I '$D(TIUPRM0)!'$D(TIUPRM1) D SETPARM^TIULE
|
|---|
| 23 | S TIUPAC=$P(TIUPRM0,U,15)
|
|---|
| 24 | I TIUPAC']"",($P(TIUPRM0,U,17)'="k") W $C(7),$C(7),$C(7),"No Pace Character Defined - Contact IRM.",! Q
|
|---|
| 25 | I $P(TIUPRM0,U,17)="k" D KERMIT(DA) Q
|
|---|
| 26 | D REMHDR("ASCII")
|
|---|
| 27 | S TIUERR=""
|
|---|
| 28 | W !,$C(TIUPAC)
|
|---|
| 29 | F R X:DTIME S:'$T X="^TIMEOUT" D Q:TIUERR'=""
|
|---|
| 30 | . I (X="^")!(X="^^")!(X="^TIMEOUT") DO Q
|
|---|
| 31 | . . S TIUERR="1,End of Message Signal not seen."
|
|---|
| 32 | . I X=EOM S TIUERR=0 W ! Q
|
|---|
| 33 | . I X?1."?" D HELP(X),REMHDR("ASCII") Q
|
|---|
| 34 | . ; Ignore leading white space
|
|---|
| 35 | . I (+$O(^TIU(8925.2,DA,"TEXT",0))'>0),(X="") Q
|
|---|
| 36 | . S TIUI=+$G(TIUI)+1,^TIU(8925.2,DA,"TEXT",TIUI,0)=$$STRIP(X)
|
|---|
| 37 | . W !,$C(TIUPAC) ; Send ACK to remote
|
|---|
| 38 | S ^TIU(8925.2,DA,"TEXT",0)="^^"_$G(TIUI)_"^"_$G(TIUI)_"^"_DT_"^^^^"
|
|---|
| 39 | Q
|
|---|
| 40 | REMHDR(PRTCL) ; Write Header for Remote upload
|
|---|
| 41 | W @IOF D JUSTIFY^TIUU($$TITLE^TIUU(PRTCL_" UPLOAD"),"C")
|
|---|
| 42 | W:PRTCL="ASCII" !!,"Initiate upload procedure:",!
|
|---|
| 43 | Q
|
|---|
| 44 | KERMIT(DA) ; Use Kermit Protocol Driver
|
|---|
| 45 | N XTKDIC,XTKERR,XTKMODE,DWLC
|
|---|
| 46 | D REMHDR("KERMIT")
|
|---|
| 47 | S XTKDIC="^TIU(8925.2,"_+DA_",""TEXT"",",XTKMODE=2
|
|---|
| 48 | D RECEIVE^XTKERMIT I +$G(XTKERR) S TIUERR=$G(XTKERR) W !
|
|---|
| 49 | Q
|
|---|
| 50 | HFS(DA) ; Read HFS file
|
|---|
| 51 | N TIUI,X
|
|---|
| 52 | I '$D(TIUPRM0)!'$D(TIUPRM1) D SETPARM^TIULE
|
|---|
| 53 | W @IOF D JUSTIFY^TIUU($$TITLE^TIUU("ASCII UPLOAD"),"C")
|
|---|
| 54 | W !!,"Select Host File:",! D ^%ZIS I POP W !,$C(7),"Device unavailable." Q
|
|---|
| 55 | F U IO R X:DTIME Q:'$T!(X=EOM)!(X="^")!(X="^^") D
|
|---|
| 56 | . U IO(0) W X,!
|
|---|
| 57 | . S TIUI=+$G(TIUI)+1,^TIU(8925.2,DA,"TEXT",TIUI,0)=$$STRIP(X)
|
|---|
| 58 | S ^TIU(8925.2,DA,"TEXT",0)="^^"_$G(TIUI)_"^"_$G(TIUI)_"^"_DT_"^^^^"
|
|---|
| 59 | D ^%ZISC
|
|---|
| 60 | Q
|
|---|
| 61 | STRIP(X) ; Strip control characters
|
|---|
| 62 | N I,Y
|
|---|
| 63 | ; First replace TABS w/5 spaces
|
|---|
| 64 | F I=1:1:$L(X) S:$A(X,I)=9 X=$E(X,1,(I-1))_" "_$E(X,(I+1),$L(X))
|
|---|
| 65 | ; Next, remove control characters
|
|---|
| 66 | S Y="" F I=1:1:$L(X) S:$A(X,I)>31 Y=Y_$E(X,I)
|
|---|
| 67 | Q Y
|
|---|
| 68 | MAKEBUF() ; Subroutine to create buffer records
|
|---|
| 69 | N DIC,DA,DR,DIE,START,X,Y
|
|---|
| 70 | S START=$$NOW^TIULC
|
|---|
| 71 | S (DIC,DLAYGO)=8925.2,DIC(0)="LX",X=""""_$J_"""" D ^DIC
|
|---|
| 72 | I +Y'>0 S DA=Y G MAKEBUX
|
|---|
| 73 | S DA=+Y,DIE=DIC,DR=".02////"_+$G(DUZ)_";.03////"_START D ^DIE
|
|---|
| 74 | MAKEBUX Q DA
|
|---|
| 75 | FILE(DA) ; Completes upload transaction, invokes filer/router
|
|---|
| 76 | N DIE,DR
|
|---|
| 77 | I '$D(^TIU(8925.2,+DA,0)) G FILEX
|
|---|
| 78 | S DIE="^TIU(8925.2,",DR=".04////"_$$NOW^TIULC D ^DIE
|
|---|
| 79 | ; Task background filer/router to process buffer record
|
|---|
| 80 | S ZTIO="",ZTDTH=$H,ZTSAVE("DA")=""
|
|---|
| 81 | S ZTRTN=$S($P(TIUPRM0,U,16)="D":"MAIN^TIUPUTD",1:"MAIN^TIUPUTC")
|
|---|
| 82 | S ZTDESC="TIU Document Filer"
|
|---|
| 83 | ; If filer is NOT designated to run in the foreground, queue it
|
|---|
| 84 | I '+$P(TIUPRM0,U,18) D G FILEX
|
|---|
| 85 | . D ^%ZTLOAD
|
|---|
| 86 | . W !,$S($D(ZTSK):"Filer/Router Queued!",1:"Filer/Router Cancelled!")
|
|---|
| 87 | ; Otherwise, run the filer in the foreground
|
|---|
| 88 | W !!,"File Transfer Complete--Now Filing Records..."
|
|---|
| 89 | D @ZTRTN
|
|---|
| 90 | FILEX Q
|
|---|
| 91 | HELP(X) ; Process HELP for Remote upload
|
|---|
| 92 | I X="?" W !?3,"Begin file transfer using ASCII protocol upload procedure.",!
|
|---|
| 93 | I X?2."?" D
|
|---|
| 94 | . W !?3,"Consult your terminal emulator's User Manual to determine",!
|
|---|
| 95 | . W !?3,"how to set-up and initiate an ASCII protocol file transfer.",!
|
|---|
| 96 | W !?3,"Enter '^' or '^^' to exit.",!
|
|---|
| 97 | S TIUX=$$READ^TIUU("FOA","Press RETURN to continue...")
|
|---|
| 98 | Q
|
|---|
