- 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 Feb 19, 2025@00:29:08 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