- MAGDRPC6 ;WOIFO/EdM - Routing RPCs ; 05/18/2007 11:23
- ;;3.0;IMAGING;**11,30,51,54**;03-July-2009;;Build 1424
- ;; Per VHA Directive 2004-038, this routine should not be modified.
- ;; +---------------------------------------------------------------+
- ;; | Property of the US Government. |
- ;; | No permission to copy or redistribute this software is given. |
- ;; | Use of unreleased versions of this software requires the user |
- ;; | to execute a written test agreement with the VistA Imaging |
- ;; | Development Office of the Department of Veterans Affairs, |
- ;; | telephone (301) 734-0100. |
- ;; | The Food and Drug Administration classifies this software as |
- ;; | a medical device. As such, it may not be changed in any way. |
- ;; | Modifications to this software may result in an adulterated |
- ;; | medical device under 21CFR820, the use of which is considered |
- ;; | to be a violation of US Federal Statutes. |
- ;; +---------------------------------------------------------------+
- ;;
- Q
- ;
- PURGDONE(OUT,DAYS,LOCATION) ; RPC = MAG DICOM ROUTE PURGE DONE
- ; Purge Entries from Queue that have been sent successfully
- N D0,DE,ID,IM,LIM,PR,RT,STS,TP,TX,X
- I '$G(LOCATION) S OUT="-1,No Location Specified" Q
- ;
- S OUT=0
- F STS="SENT","NOT FOUND" D
- . S PR="" F S PR=$O(^MAGQUEUE(2006.035,"STS",LOCATION,STS,PR)) Q:PR="" D
- . . S DE="" F S DE=$O(^MAGQUEUE(2006.035,"STS",LOCATION,STS,PR,DE)) Q:DE="" D
- . . . S RT=$P($G(^MAG(2005.2,DE,3)),"^",1) S:'RT RT=31
- . . . S:$G(DAYS)'<1 RT=DAYS
- . . . S LIM=$H-RT
- . . . S D0="" F S D0=$O(^MAGQUEUE(2006.035,"STS",LOCATION,STS,PR,DE,D0)) Q:D0="" D
- . . . . Q:$$FMTH^XLFDT($P($G(^MAGQUEUE(2006.035,D0,1)),"^",4)\1)'<LIM
- . . . . S X=$G(^MAGQUEUE(2006.035,D0,0)),IM=$P(X,"^",1),TP=$P(X,"^",3),ID=$P(X,"^",6)
- . . . . K ^MAGQUEUE(2006.035,"STS",LOCATION,STS,PR,DE,D0)
- . . . . K:ID'="" ^MAGQUEUE(2006.035,"ID",ID,D0)
- . . . . I IM'="",TP'="" K ^MAGQUEUE(2006.035,"DEST",DE,STS,IM,TP,D0)
- . . . . K ^MAGQUEUE(2006.035,D0)
- . . . . S OUT=OUT+1
- . . . . Q
- . . . Q
- . . Q
- . S DE="" F S DE=$O(^MAGQUEUE(2006.035,"DEST",DE)) Q:DE="" D
- . . S IM="" F S IM=$O(^MAGQUEUE(2006.035,"DEST",DE,STS,IM)) Q:IM="" D
- . . . S TP="" F S TP=$O(^MAGQUEUE(2006.035,"DEST",DE,STS,IM,TP)) Q:TP="" D
- . . . . S D0="" F S D0=$O(^MAGQUEUE(2006.035,"DEST",DE,STS,IM,TP,D0)) Q:D0="" D
- . . . . . S PR=$P($G(^MAGQUEUE(2006.035,D0,1)),"^",2)
- . . . . . S ID=$P($G(^MAGQUEUE(2006.035,D0,0)),"^",6)
- . . . . . K ^MAGQUEUE(2006.035,D0)
- . . . . . K:ID'="" ^MAGQUEUE(2006.035,"ID",ID,D0)
- . . . . . K ^MAGQUEUE(2006.035,"DEST",DE,STS,IM,TP,D0)
- . . . . . K:PR'="" ^MAGQUEUE(2006.035,"STS",LOCATION,STS,PR,DE,D0)
- . . . . . S OUT=OUT+1
- . . . . . Q
- . . . . Q
- . . . Q
- . . Q
- . Q
- S D0=0 F S D0=$O(^MAGQUEUE(2006.035,D0)) Q:'D0 D
- . S X=$P($G(^MAGQUEUE(2006.035,D0,1)),"^",1) I X'="SENT",X'="NOT FOUND" Q
- . S ID=$P($G(^MAGQUEUE(2006.035,D0,0)),"^",6)
- . K ^MAGQUEUE(2006.035,D0)
- . K:ID'="" ^MAGQUEUE(2006.035,"ID",ID,D0)
- . S OUT=OUT+1
- . Q
- Q
- ;
- REQUEUE(OUT,LOCATION) ; RPC = MAG DICOM ROUTE REQUEUE
- ; ReQueue Files that Failed during transmission
- N D0,DE,FL,IM,PR,TP,WW,X
- I '$G(LOCATION) S OUT="-1,No Location Specified" Q
- ;
- S WW="WAITING",OUT=0
- F FL="FAILED","SENDING" D
- . S PR="" F S PR=$O(^MAGQUEUE(2006.035,"STS",LOCATION,FL,PR)) Q:PR="" D
- . . S DE="" F S DE=$O(^MAGQUEUE(2006.035,"STS",LOCATION,FL,PR,DE)) Q:DE="" D
- . . . S D0="" F S D0=$O(^MAGQUEUE(2006.035,"STS",LOCATION,FL,PR,DE,D0)) Q:D0="" D
- . . . . K ^MAGQUEUE(2006.035,"STS",LOCATION,FL,PR,DE,D0)
- . . . . I '$D(^MAGQUEUE(2006.035,D0,0)) K ^MAGQUEUE(2006.035,D0) Q
- . . . . S $P(^MAGQUEUE(2006.035,D0,1),"^",1)=WW
- . . . . S ^MAGQUEUE(2006.035,"STS",LOCATION,WW,PR,DE,D0)=""
- . . . . S X=^MAGQUEUE(2006.035,D0,0),IM=$P(X,"^",1),TP=$P(X,"^",3)
- . . . . I IM'="",TP'="" K ^MAGQUEUE(2006.035,"DEST",DE,FL,IM,TP,D0)
- . . . . I IM'="",TP'="" S ^MAGQUEUE(2006.035,"DEST",DE,WW,IM,TP,D0)=""
- . . . . S OUT=OUT+1
- . . . . Q
- . . . Q
- . . Q
- . Q
- Q
- ;
- REMOBSO(OUT,UPTO,LOCATION) ; RPC = MAG DICOM ROUTE REMOVE OBSO
- ; Purge Unprocessed entries requested before a certain date
- N D0,DE,ID,IM,N,PRI,RDT,ST,TY
- I '$G(LOCATION) S OUT="-1,No Location Specified" Q
- ;
- S OUT=0
- S PRI="" F S PRI=$O(^MAGQUEUE(2006.035,"STS",LOCATION,"WAITING",PRI)) Q:PRI="" D
- . S DE="" F S DE=$O(^MAGQUEUE(2006.035,"STS",LOCATION,"WAITING",PRI,DE)) Q:DE="" D
- . . S D0="" F S D0=$O(^MAGQUEUE(2006.035,"STS",LOCATION,"WAITING",PRI,DE,D0)) Q:D0="" D Q:'D0
- . . . S X=$G(^MAGQUEUE(2006.035,D0,0)),IM=$P(X,"^",1),TY=$P(X,"^",3),ID=$P(X,"^",6)
- . . . S X=$G(^MAGQUEUE(2006.035,D0,1)),ST=$P(X,"^",1),RDT=$P(X,"^",3)
- . . . I RDT'<UPTO S D0=0 Q
- . . . I ST'="",IM'="",TY'="" K ^MAGQUEUE(2006.035,"DEST",DE,ST,IM,TY,D0)
- . . . K ^MAGQUEUE(2006.035,"STS",LOCATION,"WAITING",PRI,DE,D0)
- . . . K:ID'="" ^MAGQUEUE(2006.035,"ID",ID,D0)
- . . . K ^MAGQUEUE(2006.035,D0)
- . . . S OUT=OUT+1
- . . . Q
- . . Q
- . Q
- Q
- ;
- EVALLOG(OUT,TASK,MSG,MAX,LOCATION) ; RPC = MAG DICOM ROUTE EVAL LOG
- N L,N,PLACE,ZTSK
- ;
- S PLACE=$$PLACE^MAGDRPC2(LOCATION)
- S $P(^MAG(2006.1,PLACE,"LASTROUTE"),"^",1)=DT
- ;
- I '$D(^XTMP("MAGEVAL",+$G(TASK))) S OUT(1)="-1,No task #"_(+$G(TASK)) Q
- I $G(MAX)<1 S OUT(1)="-2,MAXIMUM parameter = "_$G(MAX)_" < 1" Q
- S (L,MSG)=+$G(MSG),N=1
- F S MSG=$O(^XTMP("MAGEVAL",TASK,MSG)) Q:MSG="" D Q:N'<MAX
- . S L=MSG,N=N+1,OUT(N)=^XTMP("MAGEVAL",TASK,MSG)
- . Q
- S OUT(1)=(N-1)_" "_L
- Q:N>1
- S ZTSK=TASK D STAT^%ZTLOAD
- I $G(ZTSK(2))["Inactive" S OUT(1)="-3,"_ZTSK(2) Q
- Q
- ;
- XMIT ; Continuation from MAGDRPC5
- N FROM,HASH,TO,TTP
- S (FROM,TO,OUT(7),OUT(8))=-13
- S TTP=TP S:TP="TEXT" TTP="FULL" ; MAGFILEB does not support type="TEXT"
- D FILEFIND^MAGDFB(IM,TTP,0,0,.TO,.FROM)
- S:FROM["~NO NETWORK LOCATION DEFINED" (FROM,TO)="-1~No routable files found for image "_IM
- I TP="TEXT" S TO=$E(TO,1,$L(TO)-4)_".TXT",FROM=$E(FROM,1,$L(FROM)-4)_".TXT"
- I (FROM<0)!(TO<0)!(FROM="") D STATUS^MAGDRPC5(X,D0,"SENT",LOCATION) S OUT(1)=2 Q
- S HASH=$$DIRHASH^MAGFILEB(TO,+DEST) D:HASH'=""
- . I $E(TO,1)="\",$E(HASH,$L(HASH))="\" S HASH=$E(HASH,1,$L(HASH)-1)
- . I $E(TO,1)'="\",$E(HASH,$L(HASH))'="\" S HASH=HASH_"\"
- . S TO=HASH_TO
- . Q
- D:DIR'=""
- . I $E(TO,1)="\",$E(DIR,$L(DIR))="\" S DIR=$E(DIR,1,$L(DIR)-1)
- . I $E(TO,1)'="\",$E(DIR,$L(DIR))'="\" S DIR=DIR_"\"
- . S TO=DIR_TO
- . Q
- S:$E(TO,1)'="\" TO="\"_TO
- S OUT(7)=FROM,OUT(8)=TO
- S OUT(1)=1
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDRPC6 6573 printed Mar 13, 2025@21:06:21 Page 2
- MAGDRPC6 ;WOIFO/EdM - Routing RPCs ; 05/18/2007 11:23
- +1 ;;3.0;IMAGING;**11,30,51,54**;03-July-2009;;Build 1424
- +2 ;; Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;; +---------------------------------------------------------------+
- +4 ;; | Property of the US Government. |
- +5 ;; | No permission to copy or redistribute this software is given. |
- +6 ;; | Use of unreleased versions of this software requires the user |
- +7 ;; | to execute a written test agreement with the VistA Imaging |
- +8 ;; | Development Office of the Department of Veterans Affairs, |
- +9 ;; | telephone (301) 734-0100. |
- +10 ;; | The Food and Drug Administration classifies this software as |
- +11 ;; | a medical device. As such, it may not be changed in any way. |
- +12 ;; | Modifications to this software may result in an adulterated |
- +13 ;; | medical device under 21CFR820, the use of which is considered |
- +14 ;; | to be a violation of US Federal Statutes. |
- +15 ;; +---------------------------------------------------------------+
- +16 ;;
- +17 QUIT
- +18 ;
- PURGDONE(OUT,DAYS,LOCATION) ; RPC = MAG DICOM ROUTE PURGE DONE
- +1 ; Purge Entries from Queue that have been sent successfully
- +2 NEW D0,DE,ID,IM,LIM,PR,RT,STS,TP,TX,X
- +3 IF '$GET(LOCATION)
- SET OUT="-1,No Location Specified"
- QUIT
- +4 ;
- +5 SET OUT=0
- +6 FOR STS="SENT","NOT FOUND"
- Begin DoDot:1
- +7 SET PR=""
- FOR
- SET PR=$ORDER(^MAGQUEUE(2006.035,"STS",LOCATION,STS,PR))
- if PR=""
- QUIT
- Begin DoDot:2
- +8 SET DE=""
- FOR
- SET DE=$ORDER(^MAGQUEUE(2006.035,"STS",LOCATION,STS,PR,DE))
- if DE=""
- QUIT
- Begin DoDot:3
- +9 SET RT=$PIECE($GET(^MAG(2005.2,DE,3)),"^",1)
- if 'RT
- SET RT=31
- +10 if $GET(DAYS)'<1
- SET RT=DAYS
- +11 SET LIM=$HOROLOG-RT
- +12 SET D0=""
- FOR
- SET D0=$ORDER(^MAGQUEUE(2006.035,"STS",LOCATION,STS,PR,DE,D0))
- if D0=""
- QUIT
- Begin DoDot:4
- +13 if $$FMTH^XLFDT($PIECE($GET(^MAGQUEUE(2006.035,D0,1)),"^",4)\1)'<LIM
- QUIT
- +14 SET X=$GET(^MAGQUEUE(2006.035,D0,0))
- SET IM=$PIECE(X,"^",1)
- SET TP=$PIECE(X,"^",3)
- SET ID=$PIECE(X,"^",6)
- +15 KILL ^MAGQUEUE(2006.035,"STS",LOCATION,STS,PR,DE,D0)
- +16 if ID'=""
- KILL ^MAGQUEUE(2006.035,"ID",ID,D0)
- +17 IF IM'=""
- IF TP'=""
- KILL ^MAGQUEUE(2006.035,"DEST",DE,STS,IM,TP,D0)
- +18 KILL ^MAGQUEUE(2006.035,D0)
- +19 SET OUT=OUT+1
- +20 QUIT
- End DoDot:4
- +21 QUIT
- End DoDot:3
- +22 QUIT
- End DoDot:2
- +23 SET DE=""
- FOR
- SET DE=$ORDER(^MAGQUEUE(2006.035,"DEST",DE))
- if DE=""
- QUIT
- Begin DoDot:2
- +24 SET IM=""
- FOR
- SET IM=$ORDER(^MAGQUEUE(2006.035,"DEST",DE,STS,IM))
- if IM=""
- QUIT
- Begin DoDot:3
- +25 SET TP=""
- FOR
- SET TP=$ORDER(^MAGQUEUE(2006.035,"DEST",DE,STS,IM,TP))
- if TP=""
- QUIT
- Begin DoDot:4
- +26 SET D0=""
- FOR
- SET D0=$ORDER(^MAGQUEUE(2006.035,"DEST",DE,STS,IM,TP,D0))
- if D0=""
- QUIT
- Begin DoDot:5
- +27 SET PR=$PIECE($GET(^MAGQUEUE(2006.035,D0,1)),"^",2)
- +28 SET ID=$PIECE($GET(^MAGQUEUE(2006.035,D0,0)),"^",6)
- +29 KILL ^MAGQUEUE(2006.035,D0)
- +30 if ID'=""
- KILL ^MAGQUEUE(2006.035,"ID",ID,D0)
- +31 KILL ^MAGQUEUE(2006.035,"DEST",DE,STS,IM,TP,D0)
- +32 if PR'=""
- KILL ^MAGQUEUE(2006.035,"STS",LOCATION,STS,PR,DE,D0)
- +33 SET OUT=OUT+1
- +34 QUIT
- End DoDot:5
- +35 QUIT
- End DoDot:4
- +36 QUIT
- End DoDot:3
- +37 QUIT
- End DoDot:2
- +38 QUIT
- End DoDot:1
- +39 SET D0=0
- FOR
- SET D0=$ORDER(^MAGQUEUE(2006.035,D0))
- if 'D0
- QUIT
- Begin DoDot:1
- +40 SET X=$PIECE($GET(^MAGQUEUE(2006.035,D0,1)),"^",1)
- IF X'="SENT"
- IF X'="NOT FOUND"
- QUIT
- +41 SET ID=$PIECE($GET(^MAGQUEUE(2006.035,D0,0)),"^",6)
- +42 KILL ^MAGQUEUE(2006.035,D0)
- +43 if ID'=""
- KILL ^MAGQUEUE(2006.035,"ID",ID,D0)
- +44 SET OUT=OUT+1
- +45 QUIT
- End DoDot:1
- +46 QUIT
- +47 ;
- REQUEUE(OUT,LOCATION) ; RPC = MAG DICOM ROUTE REQUEUE
- +1 ; ReQueue Files that Failed during transmission
- +2 NEW D0,DE,FL,IM,PR,TP,WW,X
- +3 IF '$GET(LOCATION)
- SET OUT="-1,No Location Specified"
- QUIT
- +4 ;
- +5 SET WW="WAITING"
- SET OUT=0
- +6 FOR FL="FAILED","SENDING"
- Begin DoDot:1
- +7 SET PR=""
- FOR
- SET PR=$ORDER(^MAGQUEUE(2006.035,"STS",LOCATION,FL,PR))
- if PR=""
- QUIT
- Begin DoDot:2
- +8 SET DE=""
- FOR
- SET DE=$ORDER(^MAGQUEUE(2006.035,"STS",LOCATION,FL,PR,DE))
- if DE=""
- QUIT
- Begin DoDot:3
- +9 SET D0=""
- FOR
- SET D0=$ORDER(^MAGQUEUE(2006.035,"STS",LOCATION,FL,PR,DE,D0))
- if D0=""
- QUIT
- Begin DoDot:4
- +10 KILL ^MAGQUEUE(2006.035,"STS",LOCATION,FL,PR,DE,D0)
- +11 IF '$DATA(^MAGQUEUE(2006.035,D0,0))
- KILL ^MAGQUEUE(2006.035,D0)
- QUIT
- +12 SET $PIECE(^MAGQUEUE(2006.035,D0,1),"^",1)=WW
- +13 SET ^MAGQUEUE(2006.035,"STS",LOCATION,WW,PR,DE,D0)=""
- +14 SET X=^MAGQUEUE(2006.035,D0,0)
- SET IM=$PIECE(X,"^",1)
- SET TP=$PIECE(X,"^",3)
- +15 IF IM'=""
- IF TP'=""
- KILL ^MAGQUEUE(2006.035,"DEST",DE,FL,IM,TP,D0)
- +16 IF IM'=""
- IF TP'=""
- SET ^MAGQUEUE(2006.035,"DEST",DE,WW,IM,TP,D0)=""
- +17 SET OUT=OUT+1
- +18 QUIT
- End DoDot:4
- +19 QUIT
- End DoDot:3
- +20 QUIT
- End DoDot:2
- +21 QUIT
- End DoDot:1
- +22 QUIT
- +23 ;
- REMOBSO(OUT,UPTO,LOCATION) ; RPC = MAG DICOM ROUTE REMOVE OBSO
- +1 ; Purge Unprocessed entries requested before a certain date
- +2 NEW D0,DE,ID,IM,N,PRI,RDT,ST,TY
- +3 IF '$GET(LOCATION)
- SET OUT="-1,No Location Specified"
- QUIT
- +4 ;
- +5 SET OUT=0
- +6 SET PRI=""
- FOR
- SET PRI=$ORDER(^MAGQUEUE(2006.035,"STS",LOCATION,"WAITING",PRI))
- if PRI=""
- QUIT
- Begin DoDot:1
- +7 SET DE=""
- FOR
- SET DE=$ORDER(^MAGQUEUE(2006.035,"STS",LOCATION,"WAITING",PRI,DE))
- if DE=""
- QUIT
- Begin DoDot:2
- +8 SET D0=""
- FOR
- SET D0=$ORDER(^MAGQUEUE(2006.035,"STS",LOCATION,"WAITING",PRI,DE,D0))
- if D0=""
- QUIT
- Begin DoDot:3
- +9 SET X=$GET(^MAGQUEUE(2006.035,D0,0))
- SET IM=$PIECE(X,"^",1)
- SET TY=$PIECE(X,"^",3)
- SET ID=$PIECE(X,"^",6)
- +10 SET X=$GET(^MAGQUEUE(2006.035,D0,1))
- SET ST=$PIECE(X,"^",1)
- SET RDT=$PIECE(X,"^",3)
- +11 IF RDT'<UPTO
- SET D0=0
- QUIT
- +12 IF ST'=""
- IF IM'=""
- IF TY'=""
- KILL ^MAGQUEUE(2006.035,"DEST",DE,ST,IM,TY,D0)
- +13 KILL ^MAGQUEUE(2006.035,"STS",LOCATION,"WAITING",PRI,DE,D0)
- +14 if ID'=""
- KILL ^MAGQUEUE(2006.035,"ID",ID,D0)
- +15 KILL ^MAGQUEUE(2006.035,D0)
- +16 SET OUT=OUT+1
- +17 QUIT
- End DoDot:3
- if 'D0
- QUIT
- +18 QUIT
- End DoDot:2
- +19 QUIT
- End DoDot:1
- +20 QUIT
- +21 ;
- EVALLOG(OUT,TASK,MSG,MAX,LOCATION) ; RPC = MAG DICOM ROUTE EVAL LOG
- +1 NEW L,N,PLACE,ZTSK
- +2 ;
- +3 SET PLACE=$$PLACE^MAGDRPC2(LOCATION)
- +4 SET $PIECE(^MAG(2006.1,PLACE,"LASTROUTE"),"^",1)=DT
- +5 ;
- +6 IF '$DATA(^XTMP("MAGEVAL",+$GET(TASK)))
- SET OUT(1)="-1,No task #"_(+$GET(TASK))
- QUIT
- +7 IF $GET(MAX)<1
- SET OUT(1)="-2,MAXIMUM parameter = "_$GET(MAX)_" < 1"
- QUIT
- +8 SET (L,MSG)=+$GET(MSG)
- SET N=1
- +9 FOR
- SET MSG=$ORDER(^XTMP("MAGEVAL",TASK,MSG))
- if MSG=""
- QUIT
- Begin DoDot:1
- +10 SET L=MSG
- SET N=N+1
- SET OUT(N)=^XTMP("MAGEVAL",TASK,MSG)
- +11 QUIT
- End DoDot:1
- if N'<MAX
- QUIT
- +12 SET OUT(1)=(N-1)_" "_L
- +13 if N>1
- QUIT
- +14 SET ZTSK=TASK
- DO STAT^%ZTLOAD
- +15 IF $GET(ZTSK(2))["Inactive"
- SET OUT(1)="-3,"_ZTSK(2)
- QUIT
- +16 QUIT
- +17 ;
- XMIT ; Continuation from MAGDRPC5
- +1 NEW FROM,HASH,TO,TTP
- +2 SET (FROM,TO,OUT(7),OUT(8))=-13
- +3 ; MAGFILEB does not support type="TEXT"
- SET TTP=TP
- if TP="TEXT"
- SET TTP="FULL"
- +4 DO FILEFIND^MAGDFB(IM,TTP,0,0,.TO,.FROM)
- +5 if FROM["~NO NETWORK LOCATION DEFINED"
- SET (FROM,TO)="-1~No routable files found for image "_IM
- +6 IF TP="TEXT"
- SET TO=$EXTRACT(TO,1,$LENGTH(TO)-4)_".TXT"
- SET FROM=$EXTRACT(FROM,1,$LENGTH(FROM)-4)_".TXT"
- +7 IF (FROM<0)!(TO<0)!(FROM="")
- DO STATUS^MAGDRPC5(X,D0,"SENT",LOCATION)
- SET OUT(1)=2
- QUIT
- +8 SET HASH=$$DIRHASH^MAGFILEB(TO,+DEST)
- if HASH'=""
- Begin DoDot:1
- +9 IF $EXTRACT(TO,1)="\"
- IF $EXTRACT(HASH,$LENGTH(HASH))="\"
- SET HASH=$EXTRACT(HASH,1,$LENGTH(HASH)-1)
- +10 IF $EXTRACT(TO,1)'="\"
- IF $EXTRACT(HASH,$LENGTH(HASH))'="\"
- SET HASH=HASH_"\"
- +11 SET TO=HASH_TO
- +12 QUIT
- End DoDot:1
- +13 if DIR'=""
- Begin DoDot:1
- +14 IF $EXTRACT(TO,1)="\"
- IF $EXTRACT(DIR,$LENGTH(DIR))="\"
- SET DIR=$EXTRACT(DIR,1,$LENGTH(DIR)-1)
- +15 IF $EXTRACT(TO,1)'="\"
- IF $EXTRACT(DIR,$LENGTH(DIR))'="\"
- SET DIR=DIR_"\"
- +16 SET TO=DIR_TO
- +17 QUIT
- End DoDot:1
- +18 if $EXTRACT(TO,1)'="\"
- SET TO="\"_TO
- +19 SET OUT(7)=FROM
- SET OUT(8)=TO
- +20 SET OUT(1)=1
- +21 QUIT
- +22 ;
