SDWLFUL ;;IOFO BAY PINES/TEH - REPAIR/RE-CAL ENROLLE STATUS;06/12/2002 ; 20 Aug 20022:10 PM
;;5.3;scheduling;**525**;AUG 13 1993;Build 47
;
;
;
;
;
;
;=========================================================================================================
;
;Foreign file upload utility for KLF data.
;
;
;
Q
EN ;Initial variables
;
I '$D(^XTMP("SDWLFULSTAT",$J,"1B")) W !,"You must run a BACK-UP before running this option." Q
I $D(^XTMP("SDWLFULSTAT",$J,2)) W !,"You have already run this option." D I 'Y Q
.S DIR(0)="Y",DIR("A")="Are you absolutely sure you want to continue",DIR("B")="N" D ^DIR D
..I X["^" S Y=0 Q
..I X["N"!(X["n") S Y=0 Q
S STIME=$H,SDWLCNT=0
S SDHAN="VSSCFILE",SDFILNM="FLAK9.CSV;1",SDPATH="USER$:[TEMP]",SDMOD="R"
S DIR("A")="PATH: ",DIR("B")=SDPATH,DIR(0)="F" D ^DIR
S SDPATH=Y
K ^XTMP("SDWLFUL")
D OPEN^%ZISH(SDHAN,SDPATH,SDFILNM,SDMOD)
Q:POP S L=0
F I=1:1 U IO R X:DTIME Q:X="" D EN0,DOT
END S ETIME=$H
D CLOSE^%ZISH(SDHAN) S:$D(ZTQUEUED) ZTREQ="@" W !,"Transfer Complete"
K DIR,I,POP,SDFILNM,SDHAN,SDMOD,SDPATH,SDWLCNT,SDWLCTD,SDWLICN,SDWLINS
K SDWLLD,SDWLLDT,SDWLOD,SDWLODT,SDWLSSN,STIME,X,Y,ZTQUEUED,ZTREQ,ETIME,L
S ^XTMP("SDWLFULSTAT",$J,2)=""
Q
EN0 ;
S SDWLICN=$P(X,",",1),SDWLODT=$P(X,",",2),SDWLLDT=$P(X,",",3),SDWLSSN=$P(X,",",4),SDWLINS=$P(X,",",5) D
.I '$D(^DPT("SSN",SDWLSSN)) Q
.S X=SDWLODT D ^%DT S SDWLOD=Y,X=SDWLLDT D ^%DT S SDWLLD=Y
.I '$D(^XTMP("SDWLFUL",$J,SDWLSSN,SDWLOD)) S ^XTMP("SDWLFUL",$J,SDWLSSN,SDWLOD)=SDWLLD_"^"_SDWLINS Q
.I $D(^XTMP("SDWLFUL",$J,SDWLSSN,SDWLOD)) I SDWLLD'>SDWLOD D
..S SDWLCTD=$P($G(^XTMP("SDWLFUL",$J,SDWLSSN,SDWLOD)),U) D
...I SDWLLD>SDWLCTD&(SDWLLD'>SDWLOD) S ^XTMP("SDWLFUL",$J,SDWLSSN,SDWLOD)=SDWLLD_"^"_SDWLINS
Q
DOT S SDWLCNT=SDWLCNT+1 I SDWLCNT#10000=0 U $P W SDWLCNT,! U IO
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDWLFUL 1852 printed Apr 09, 2024@21:52 Page 2
SDWLFUL ;;IOFO BAY PINES/TEH - REPAIR/RE-CAL ENROLLE STATUS;06/12/2002 ; 20 Aug 20022:10 PM
+1 ;;5.3;scheduling;**525**;AUG 13 1993;Build 47
+2 ;
+3 ;
+4 ;
+5 ;
+6 ;
+7 ;
+8 ;=========================================================================================================
+9 ;
+10 ;Foreign file upload utility for KLF data.
+11 ;
+12 ;
+13 ;
+14 QUIT
EN ;Initial variables
+1 ;
+2 IF '$DATA(^XTMP("SDWLFULSTAT",$JOB,"1B"))
WRITE !,"You must run a BACK-UP before running this option."
QUIT
+3 IF $DATA(^XTMP("SDWLFULSTAT",$JOB,2))
WRITE !,"You have already run this option."
Begin DoDot:1
+4 SET DIR(0)="Y"
SET DIR("A")="Are you absolutely sure you want to continue"
SET DIR("B")="N"
DO ^DIR
Begin DoDot:2
+5 IF X["^"
SET Y=0
QUIT
+6 IF X["N"!(X["n")
SET Y=0
QUIT
End DoDot:2
End DoDot:1
IF 'Y
QUIT
+7 SET STIME=$HOROLOG
SET SDWLCNT=0
+8 SET SDHAN="VSSCFILE"
SET SDFILNM="FLAK9.CSV;1"
SET SDPATH="USER$:[TEMP]"
SET SDMOD="R"
+9 SET DIR("A")="PATH: "
SET DIR("B")=SDPATH
SET DIR(0)="F"
DO ^DIR
+10 SET SDPATH=Y
+11 KILL ^XTMP("SDWLFUL")
+12 DO OPEN^%ZISH(SDHAN,SDPATH,SDFILNM,SDMOD)
+13 if POP
QUIT
SET L=0
+14 FOR I=1:1
USE IO
READ X:DTIME
if X=""
QUIT
DO EN0
DO DOT
END SET ETIME=$HOROLOG
+1 DO CLOSE^%ZISH(SDHAN)
if $DATA(ZTQUEUED)
SET ZTREQ="@"
WRITE !,"Transfer Complete"
+2 KILL DIR,I,POP,SDFILNM,SDHAN,SDMOD,SDPATH,SDWLCNT,SDWLCTD,SDWLICN,SDWLINS
+3 KILL SDWLLD,SDWLLDT,SDWLOD,SDWLODT,SDWLSSN,STIME,X,Y,ZTQUEUED,ZTREQ,ETIME,L
+4 SET ^XTMP("SDWLFULSTAT",$JOB,2)=""
+5 QUIT
EN0 ;
+1 SET SDWLICN=$PIECE(X,",",1)
SET SDWLODT=$PIECE(X,",",2)
SET SDWLLDT=$PIECE(X,",",3)
SET SDWLSSN=$PIECE(X,",",4)
SET SDWLINS=$PIECE(X,",",5)
Begin DoDot:1
+2 IF '$DATA(^DPT("SSN",SDWLSSN))
QUIT
+3 SET X=SDWLODT
DO ^%DT
SET SDWLOD=Y
SET X=SDWLLDT
DO ^%DT
SET SDWLLD=Y
+4 IF '$DATA(^XTMP("SDWLFUL",$JOB,SDWLSSN,SDWLOD))
SET ^XTMP("SDWLFUL",$JOB,SDWLSSN,SDWLOD)=SDWLLD_"^"_SDWLINS
QUIT
+5 IF $DATA(^XTMP("SDWLFUL",$JOB,SDWLSSN,SDWLOD))
IF SDWLLD'>SDWLOD
Begin DoDot:2
+6 SET SDWLCTD=$PIECE($GET(^XTMP("SDWLFUL",$JOB,SDWLSSN,SDWLOD)),U)
Begin DoDot:3
+7 IF SDWLLD>SDWLCTD&(SDWLLD'>SDWLOD)
SET ^XTMP("SDWLFUL",$JOB,SDWLSSN,SDWLOD)=SDWLLD_"^"_SDWLINS
End DoDot:3
End DoDot:2
End DoDot:1
+8 QUIT
DOT SET SDWLCNT=SDWLCNT+1
IF SDWLCNT#10000=0
USE $PRINCIPAL
WRITE SDWLCNT,!
USE IO
+1 QUIT
