Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIUUPLD

TIUUPLD.m

Go to the documentation of this file.
  1. TIUUPLD ; SLC/JER - ASCII Upload ;9/11/98@16:39:47
  1. ;;1.0;TEXT INTEGRATION UTILITIES;**21**;Jun 20, 1997
  1. MAIN ; Control branching
  1. N EOM,TIUDA,TIUERR,TIUHDR,TIULN,TIUSRC,X
  1. I '$D(TIUPRM0)!'$D(TIUPRM1) D SETPARM^TIULE
  1. S TIUSRC=$P($G(TIUPRM0),U,9),EOM=$P($G(TIUPRM0),U,11)
  1. I EOM']"",($P(TIUPRM0,U,17)'="k") W !,$C(7),$C(7),$C(7),"No End of Message Signal Defined - Contact IRM.",! Q
  1. S:TIUSRC']"" TIUSRC="R"
  1. S TIUHDR=$P(TIUPRM0,U,10)
  1. I TIUHDR']"" W $C(7),$C(7),$C(7),"No Record Header Signal Defined - Contact IRM.",! Q
  1. S TIUDA=$$MAKEBUF
  1. I +TIUDA'>0 W $C(7),$C(7),$C(7),"Unable to create a Buffer File Record - Contact IRM.",! Q
  1. I TIUSRC="R" D REMOTE(TIUDA)
  1. I TIUSRC="H" D HFS(TIUDA)
  1. I +$G(TIUERR) W $C(7),$C(7),$C(7),!,"File Transfer Error: ",$G(TIUERR),!!,"Please re-transmit the file...",!
  1. ; Set $ZB to MAIN+14^TIUUPLD:2
  1. I +$O(^TIU(8925.2,TIUDA,"TEXT",0))>0,'+$G(TIUERR) D FILE(TIUDA)
  1. I +$O(^TIU(8925.2,TIUDA,"TEXT",0))'>0!+$G(TIUERR) D BUFPURGE^TIUPUTC(TIUDA)
  1. Q
  1. REMOTE(DA) ; Read ASCII stream from remote computer
  1. N TIUI,TIUPAC,X
  1. I '$D(TIUPRM0)!'$D(TIUPRM1) D SETPARM^TIULE
  1. S TIUPAC=$P(TIUPRM0,U,15)
  1. I TIUPAC']"",($P(TIUPRM0,U,17)'="k") W $C(7),$C(7),$C(7),"No Pace Character Defined - Contact IRM.",! Q
  1. I $P(TIUPRM0,U,17)="k" D KERMIT(DA) Q
  1. D REMHDR("ASCII")
  1. S TIUERR=""
  1. W !,$C(TIUPAC)
  1. F R X:DTIME S:'$T X="^TIMEOUT" D Q:TIUERR'=""
  1. . I (X="^")!(X="^^")!(X="^TIMEOUT") DO Q
  1. . . S TIUERR="1,End of Message Signal not seen."
  1. . I X=EOM S TIUERR=0 W ! Q
  1. . I X?1."?" D HELP(X),REMHDR("ASCII") Q
  1. . ; Ignore leading white space
  1. . I (+$O(^TIU(8925.2,DA,"TEXT",0))'>0),(X="") Q
  1. . S TIUI=+$G(TIUI)+1,^TIU(8925.2,DA,"TEXT",TIUI,0)=$$STRIP(X)
  1. . W !,$C(TIUPAC) ; Send ACK to remote
  1. S ^TIU(8925.2,DA,"TEXT",0)="^^"_$G(TIUI)_"^"_$G(TIUI)_"^"_DT_"^^^^"
  1. Q
  1. REMHDR(PRTCL) ; Write Header for Remote upload
  1. W @IOF D JUSTIFY^TIUU($$TITLE^TIUU(PRTCL_" UPLOAD"),"C")
  1. W:PRTCL="ASCII" !!,"Initiate upload procedure:",!
  1. Q
  1. KERMIT(DA) ; Use Kermit Protocol Driver
  1. N XTKDIC,XTKERR,XTKMODE,DWLC
  1. D REMHDR("KERMIT")
  1. S XTKDIC="^TIU(8925.2,"_+DA_",""TEXT"",",XTKMODE=2
  1. D RECEIVE^XTKERMIT I +$G(XTKERR) S TIUERR=$G(XTKERR) W !
  1. Q
  1. HFS(DA) ; Read HFS file
  1. N TIUI,X
  1. I '$D(TIUPRM0)!'$D(TIUPRM1) D SETPARM^TIULE
  1. W @IOF D JUSTIFY^TIUU($$TITLE^TIUU("ASCII UPLOAD"),"C")
  1. W !!,"Select Host File:",! D ^%ZIS I POP W !,$C(7),"Device unavailable." Q
  1. F U IO R X:DTIME Q:'$T!(X=EOM)!(X="^")!(X="^^") D
  1. . U IO(0) W X,!
  1. . S TIUI=+$G(TIUI)+1,^TIU(8925.2,DA,"TEXT",TIUI,0)=$$STRIP(X)
  1. S ^TIU(8925.2,DA,"TEXT",0)="^^"_$G(TIUI)_"^"_$G(TIUI)_"^"_DT_"^^^^"
  1. D ^%ZISC
  1. Q
  1. STRIP(X) ; Strip control characters
  1. N I,Y
  1. ; First replace TABS w/5 spaces
  1. F I=1:1:$L(X) S:$A(X,I)=9 X=$E(X,1,(I-1))_" "_$E(X,(I+1),$L(X))
  1. ; Next, remove control characters
  1. S Y="" F I=1:1:$L(X) S:$A(X,I)>31 Y=Y_$E(X,I)
  1. Q Y
  1. MAKEBUF() ; Subroutine to create buffer records
  1. N DIC,DA,DR,DIE,START,X,Y
  1. S START=$$NOW^TIULC
  1. S (DIC,DLAYGO)=8925.2,DIC(0)="LX",X=""""_$J_"""" D ^DIC
  1. I +Y'>0 S DA=Y G MAKEBUX
  1. S DA=+Y,DIE=DIC,DR=".02////"_+$G(DUZ)_";.03////"_START D ^DIE
  1. MAKEBUX Q DA
  1. FILE(DA) ; Completes upload transaction, invokes filer/router
  1. N DIE,DR
  1. I '$D(^TIU(8925.2,+DA,0)) G FILEX
  1. S DIE="^TIU(8925.2,",DR=".04////"_$$NOW^TIULC D ^DIE
  1. ; Task background filer/router to process buffer record
  1. S ZTIO="",ZTDTH=$H,ZTSAVE("DA")=""
  1. S ZTRTN=$S($P(TIUPRM0,U,16)="D":"MAIN^TIUPUTD",1:"MAIN^TIUPUTC")
  1. S ZTDESC="TIU Document Filer"
  1. ; If filer is NOT designated to run in the foreground, queue it
  1. I '+$P(TIUPRM0,U,18) D G FILEX
  1. . D ^%ZTLOAD
  1. . W !,$S($D(ZTSK):"Filer/Router Queued!",1:"Filer/Router Cancelled!")
  1. ; Otherwise, run the filer in the foreground
  1. W !!,"File Transfer Complete--Now Filing Records..."
  1. D @ZTRTN
  1. FILEX Q
  1. HELP(X) ; Process HELP for Remote upload
  1. I X="?" W !?3,"Begin file transfer using ASCII protocol upload procedure.",!
  1. I X?2."?" D
  1. . W !?3,"Consult your terminal emulator's User Manual to determine",!
  1. . W !?3,"how to set-up and initiate an ASCII protocol file transfer.",!
  1. W !?3,"Enter '^' or '^^' to exit.",!
  1. S TIUX=$$READ^TIUU("FOA","Press RETURN to continue...")
  1. Q