AZAXCON9 ;IHS/PHXAO/AEF - CONVERT ROUTINE FILE FROM CACHE TO MSM [ 08/05/2004 3:07 PM ]
;;1.0;ANNE'S SPECIAL ROUTINES;;AUG 05, 2004
;
DESC ;----- ROUTINE DESCRIPTION
;;
;; This routine will convert a CACHE routine %RO file into an
;; MSM compatible file.
;;
;;$$END
;
EN ;EP -- MAIN ENTRY POINT
;
D ^XBKVAR
D HOME^%ZIS
D PROC
D KILL
Q
PROC ;----- PROCESS DATA
;
N FILEF,FILET,OUT,PATH
;
S OUT=0
;
D TXT
;
D SELP(.PATH,.OUT)
Q:OUT
;
D SELF(.FILEF,.FILET,.OUT)
Q:OUT
;
D READ(PATH,FILEF,.OUT)
Q:OUT
;
D CONV(FILEF,PATH,.OUT)
Q:OUT
;
D PUT(PATH,FILET,.OUT)
Q:OUT
;
H 2
W !,"File '"_PATH_FILET_"' created!"
Q
SELP(PATH,OUT) ;
;----- SELECT DIRECTORY OR PATH WHERE FILE RESIDES
;
N DIR,DIRUT,DTOUT,DUOUT,X,Y
;
S PATH=""
S DIR(0)="FA"
S DIR("A")="Select PATH: "
S DIR("B")=$$PWD^%ZISH
S DIR("?")="The PATH where the file to be converted resides"
D ^DIR
I Y']""!($D(DIRUT))!($D(DUOUT))!($D(DTOUT)) S OUT=1
Q:OUT
S X=Y
D DF^%ZISH(.X)
S PATH=X
Q
SELF(FILEF,FILET,OUT) ;
;----- SELECT FILES TO BE CONVERTED
;
N DIR,DIRUT,DTOUT,DUOUT,X,Y
;
S (FILEF,FILET)=""
S DIR(0)="FA"
S DIR("A")="Select file to be CONVERTED: "
S DIR("?")="Enter the FILE containing the data to be converted"
D ^DIR
I Y']""!($D(DIRUT))!($D(DUOUT))!($D(DTOUT)) S OUT=1
Q:OUT
S FILEF=Y
;
S DIR("A")="Select NEW file name: "
D ^DIR
I Y']""!($D(DIRUT))!($D(DUOUT))!($D(DTOUT)) S OUT=1
Q:OUT
S FILET=Y
Q
READ(PATH,FILE,OUT) ;
;----- READS CONTENTS OF FILE
;
; RETURNS CONTENTS OF FILE IN ^TMP("AZAX",$J,"FILE",IEN,0)
;
; PATH = DIRECTORY CONTAINING FILE
; EXAMPLES: /usr/spool/uucppublic/
; c:\inetpub\ftproot\pub\
; FILE = ROUTINE FILE CONTAINING DATA TO BE READ
; EXAMPLE: AZAXVL.ROU
; HFS = HOST FILE SERVER
; EOF = END OF FILE
; OUT = QUIT CONTROLLER
;
N EOF,I,J,X
;
D ^XBKVAR
K ^TMP("AZAX",$J,"FILE")
S EOF=0
;
D OPEN^%ZISH("FILE",PATH,FILE,"R")
I POP D
. W !,"UNABLE TO OPEN FILE '"_PATH_FILE_"'"
. S OUT=1
Q:OUT
;
U IO
F I=1:1 D Q:EOF
. R X:DTIME
. I $$STATUS^%ZISH S EOF=1 Q
. F J="":1:31 S X=$TR(X,$C(J)) ; REMOVE ALL CONTROL CHARACTERS
. S ^TMP("AZAX",$J,"FILE",I,0)=X
. S ^TMP("AZAX",$J,"FILE",0)=$G(^TMP("AZAX",$J,"FILE",0))+1
;
D CLOSE^%ZISH("FILE")
Q
CONV(FILE,PATH,OUT) ;
;----- CONVERT DATA FROM CACHE TO MSM FORMAT
;
N I,X,Y
;
I '$D(^TMP("AZAX",$J,"FILE")) S OUT=1
Q:OUT
;
F I=1:1:3 S X(I)=$G(^TMP("AZAX",$J,"FILE",I,0))
;
I X(1)'["Format=Cache"&($E(X(2),1,3)'="%RO") D
. W !,"'"_FILE_"' does not appear to be a Cache routine file"
. S OUT=1
Q:OUT
;
S Y=X(2)
S Y(1)=$P(Y," ",2)_" "_$P(Y," ",3)_"-"_$P(Y," ",4)_"-"_$E($P(Y," ",5),3,4)
S Y=X(1)
S Y(2)=$P(X(1),U,3)
S Y=X(3)
S Y(3)=$P(X(3),U)
;
F I=1:1:3 S ^TMP("AZAX",$J,"FILE",I,0)=Y(I)
Q
PUT(PATH,FILE,OUT) ;
;----- PUT DATA INTO NEW FILE
;
N POP,X,Y
;
Q:'$D(^TMP("AZAX",$J,"FILE"))
D OPEN^%ZISH("FILE",PATH,FILE,"W")
I POP D Q
. W !,"UNABLE TO OPEN FILE '"_PATH_FILE_"'"
. S OUT=1
U IO
S X=0
F S X=$O(^TMP("AZAX",$J,"FILE",X)) Q:'X D
. W $G(^TMP("AZAX",$J,"FILE",X,0))
. I $O(^TMP("AZAX",$J,"FILE",X)) W !
;
D CLOSE^%ZISH("FILE")
Q
TXT ;----- PRINT OPTION DESCRIPTION
;
N I,X
F I=1:1 S X=$P($T(DESC+I),";",3) Q:X["$$END" W !,X
Q
KILL ;----- HOUSEKEEPING
;
K ^TMP("AZAX",$J,"FILE")
Q
AZAXCON9 ;IHS/PHXAO/AEF - CONVERT ROUTINE FILE FROM CACHE TO MSM [ 08/05/2004 3:07 PM ]
+1 ;;1.0;ANNE'S SPECIAL ROUTINES;;AUG 05, 2004
+2 ;
DESC ;----- ROUTINE DESCRIPTION
+1 ;;
+2 ;; This routine will convert a CACHE routine %RO file into an
+3 ;; MSM compatible file.
+4 ;;
+5 ;;$$END
+6 ;
EN ;EP -- MAIN ENTRY POINT
+1 ;
+2 DO ^XBKVAR
+3 DO HOME^%ZIS
+4 DO PROC
+5 DO KILL
+6 QUIT
PROC ;----- PROCESS DATA
+1 ;
+2 NEW FILEF,FILET,OUT,PATH
+3 ;
+4 SET OUT=0
+5 ;
+6 DO TXT
+7 ;
+8 DO SELP(.PATH,.OUT)
+9 IF OUT
QUIT
+10 ;
+11 DO SELF(.FILEF,.FILET,.OUT)
+12 IF OUT
QUIT
+13 ;
+14 DO READ(PATH,FILEF,.OUT)
+15 IF OUT
QUIT
+16 ;
+17 DO CONV(FILEF,PATH,.OUT)
+18 IF OUT
QUIT
+19 ;
+20 DO PUT(PATH,FILET,.OUT)
+21 IF OUT
QUIT
+22 ;
+23 HANG 2
+24 WRITE !,"File '"_PATH_FILET_"' created!"
+25 QUIT
SELP(PATH,OUT) ;
+1 ;----- SELECT DIRECTORY OR PATH WHERE FILE RESIDES
+2 ;
+3 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+4 ;
+5 SET PATH=""
+6 SET DIR(0)="FA"
+7 SET DIR("A")="Select PATH: "
+8 SET DIR("B")=$$PWD^%ZISH
+9 SET DIR("?")="The PATH where the file to be converted resides"
+10 DO ^DIR
+11 IF Y']""!($DATA(DIRUT))!($DATA(DUOUT))!($DATA(DTOUT))
SET OUT=1
+12 IF OUT
QUIT
+13 SET X=Y
+14 DO DF^%ZISH(.X)
+15 SET PATH=X
+16 QUIT
SELF(FILEF,FILET,OUT) ;
+1 ;----- SELECT FILES TO BE CONVERTED
+2 ;
+3 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+4 ;
+5 SET (FILEF,FILET)=""
+6 SET DIR(0)="FA"
+7 SET DIR("A")="Select file to be CONVERTED: "
+8 SET DIR("?")="Enter the FILE containing the data to be converted"
+9 DO ^DIR
+10 IF Y']""!($DATA(DIRUT))!($DATA(DUOUT))!($DATA(DTOUT))
SET OUT=1
+11 IF OUT
QUIT
+12 SET FILEF=Y
+13 ;
+14 SET DIR("A")="Select NEW file name: "
+15 DO ^DIR
+16 IF Y']""!($DATA(DIRUT))!($DATA(DUOUT))!($DATA(DTOUT))
SET OUT=1
+17 IF OUT
QUIT
+18 SET FILET=Y
+19 QUIT
READ(PATH,FILE,OUT) ;
+1 ;----- READS CONTENTS OF FILE
+2 ;
+3 ; RETURNS CONTENTS OF FILE IN ^TMP("AZAX",$J,"FILE",IEN,0)
+4 ;
+5 ; PATH = DIRECTORY CONTAINING FILE
+6 ; EXAMPLES: /usr/spool/uucppublic/
+7 ; c:\inetpub\ftproot\pub\
+8 ; FILE = ROUTINE FILE CONTAINING DATA TO BE READ
+9 ; EXAMPLE: AZAXVL.ROU
+10 ; HFS = HOST FILE SERVER
+11 ; EOF = END OF FILE
+12 ; OUT = QUIT CONTROLLER
+13 ;
+14 NEW EOF,I,J,X
+15 ;
+16 DO ^XBKVAR
+17 KILL ^TMP("AZAX",$JOB,"FILE")
+18 SET EOF=0
+19 ;
+20 DO OPEN^%ZISH("FILE",PATH,FILE,"R")
+21 IF POP
Begin DoDot:1
+22 WRITE !,"UNABLE TO OPEN FILE '"_PATH_FILE_"'"
+23 SET OUT=1
End DoDot:1
+24 IF OUT
QUIT
+25 ;
+26 USE IO
+27 FOR I=1:1
Begin DoDot:1
+28 READ X:DTIME
+29 IF $$STATUS^%ZISH
SET EOF=1
QUIT
+30 ; REMOVE ALL CONTROL CHARACTERS
FOR J="":1:31
SET X=$TRANSLATE(X,$CHAR(J))
+31 SET ^TMP("AZAX",$JOB,"FILE",I,0)=X
+32 SET ^TMP("AZAX",$JOB,"FILE",0)=$GET(^TMP("AZAX",$JOB,"FILE",0))+1
End DoDot:1
IF EOF
QUIT
+33 ;
+34 DO CLOSE^%ZISH("FILE")
+35 QUIT
CONV(FILE,PATH,OUT) ;
+1 ;----- CONVERT DATA FROM CACHE TO MSM FORMAT
+2 ;
+3 NEW I,X,Y
+4 ;
+5 IF '$DATA(^TMP("AZAX",$JOB,"FILE"))
SET OUT=1
+6 IF OUT
QUIT
+7 ;
+8 FOR I=1:1:3
SET X(I)=$GET(^TMP("AZAX",$JOB,"FILE",I,0))
+9 ;
+10 IF X(1)'["Format=Cache"&($EXTRACT(X(2),1,3)'="%RO")
Begin DoDot:1
+11 WRITE !,"'"_FILE_"' does not appear to be a Cache routine file"
+12 SET OUT=1
End DoDot:1
+13 IF OUT
QUIT
+14 ;
+15 SET Y=X(2)
+16 SET Y(1)=$PIECE(Y," ",2)_" "_$PIECE(Y," ",3)_"-"_$PIECE(Y," ",4)_"-"_$EXTRACT($PIECE(Y," ",5),3,4)
+17 SET Y=X(1)
+18 SET Y(2)=$PIECE(X(1),U,3)
+19 SET Y=X(3)
+20 SET Y(3)=$PIECE(X(3),U)
+21 ;
+22 FOR I=1:1:3
SET ^TMP("AZAX",$JOB,"FILE",I,0)=Y(I)
+23 QUIT
PUT(PATH,FILE,OUT) ;
+1 ;----- PUT DATA INTO NEW FILE
+2 ;
+3 NEW POP,X,Y
+4 ;
+5 IF '$DATA(^TMP("AZAX",$JOB,"FILE"))
QUIT
+6 DO OPEN^%ZISH("FILE",PATH,FILE,"W")
+7 IF POP
Begin DoDot:1
+8 WRITE !,"UNABLE TO OPEN FILE '"_PATH_FILE_"'"
+9 SET OUT=1
End DoDot:1
QUIT
+10 USE IO
+11 SET X=0
+12 FOR
SET X=$ORDER(^TMP("AZAX",$JOB,"FILE",X))
IF 'X
QUIT
Begin DoDot:1
+13 WRITE $GET(^TMP("AZAX",$JOB,"FILE",X,0))
+14 IF $ORDER(^TMP("AZAX",$JOB,"FILE",X))
WRITE !
End DoDot:1
+15 ;
+16 DO CLOSE^%ZISH("FILE")
+17 QUIT
TXT ;----- PRINT OPTION DESCRIPTION
+1 ;
+2 NEW I,X
+3 FOR I=1:1
SET X=$PIECE($TEXT(DESC+I),";",3)
IF X["$$END"
QUIT
WRITE !,X
+4 QUIT
KILL ;----- HOUSEKEEPING
+1 ;
+2 KILL ^TMP("AZAX",$JOB,"FILE")
+3 QUIT
