SCRPTHST ;ALB/DJS - Team History Extract for PCMMR Data Validation; 04/10/14
;;5.3;Scheduling;**620**;AUG 13, 1993;Build 11
;
ENTER ; Entry point
;
; Extract file will be a delimited text file (.TXT) that will provide information for PCMM data validation
; Delimiter is a pipe ("|") character
;
; FILE OUTPUT:
;
; STANUM - Station #
; TIEN - IEN of Team
; TNAME - Name of Team
; EFFDT - Effective Date
; STATUS - Status
; STATRSN - Status Reason
;
N SCMCPATH,SCMCHFS,SCMCERR,MSG,SCMCMODE,IOF,SITE
N SCDATA,SCIENS,STANUM,TIEN,TNAME,EFFDT,STATUS,STATRSN
S SITE=$$SITE^VASITE,STANUM=$P(SITE,"^",3)
S SCMCPATH=$$DEFDIR^%ZISH(),SCMCHFS=STANUM_"_PCMMTEAMHISTORY.TXT",SCMCERR=0 U 0 W !!,SCMCPATH
D HFSOPEN("SCMCRP",SCMCPATH,SCMCHFS,"W") I SCMCERR G END
U IO
D COLHDR,SETREC G END
;
SETREC ;$O through Team History file and find history for all teams
S TIEN=0
F S TIEN=$O(^SCTM(404.58,TIEN)) Q:TIEN=""!(TIEN'?.N) D
.K SCDATA
.S SCIENS=+$G(TIEN)_","
.D GETS^DIQ(404.58,SCIENS,".01;.02;.03;.04","IE","SCDATA","")
.S TNAME=$G(SCDATA(404.58,SCIENS,.01,"E"))
.S EFFDT=$G(SCDATA(404.58,SCIENS,.02,"E"))
.S STATUS=$G(SCDATA(404.58,SCIENS,.03,"E"))
.S STATRSN=$G(SCDATA(404.58,SCIENS,.04,"E"))
.W STANUM_"|"_TIEN_"|"_TNAME_"|"_EFFDT_"|"_STATUS_"|"_STATRSN,!
Q
;
COLHDR ;Create column header for Team History extract file
W "Station #|Team History IEN|Team Name|Effective Date|Status|Status Reason",!
Q
;
END D HFSCLOSE("SCMCRP",SCMCHFS)
N I
I '+SCMCERR D Q ;Create pipe delimited output if no errors
.S MSG=$NA(^TMP("SCMC",$J))
;Replace "##FFFF##" with Form Feeds - code needed for LINUX environments
S I=0 F S I=$O(^TMP("SCMC",$J,1,I)) Q:'I D
.S:^TMP("SCMC",$J,1,I)["##FFFF##" ^TMP("SCMC",$J,1,I)=$P(^TMP("SCMC",$J,1,I),"##FFFF##")_$C(13,12)_$P(^TMP("SCMC",$J,1,I),"##FFFF##",2)
.S ^TMP("SCMC",$J,1,I)=^TMP("SCMC",$J,1,I)_$C(13)
.S:^TMP("SCMC",$J,1,I)["$END" ^TMP("SCMC",$J,1,I)=""
S MSG=$NA(^TMP("SCMC",$J))
Q
;
HFSOPEN(HANDLE,SCMCPATH,SCMCHFS,SCMCMODE) ; Open File
N POP
D OPEN^%ZISH(HANDLE,SCMCPATH,SCMCHFS,$G(SCMCMODE,"W")) D:POP Q:POP
.S SCMCERR=1,^TMP("SCMC",$J,1)="0^Unable to open file "
S IOF="$$IOF^SCRPTHST" ;resets screen position and adds page break flag - added to deal with Linux environments.
Q
;
HFSCLOSE(HANDLE,SCMHFS) ;Close HFS and unload data
D CLOSE^%ZISH(HANDLE)
Q
;
IOF() ;used to reset position and insert page break flag when @IOF is executed.
S $X=0,$Y=0
Q "##FFFF##"_$C(13,10)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCRPTHST 2536 printed Dec 13, 2024@02:43 Page 2
SCRPTHST ;ALB/DJS - Team History Extract for PCMMR Data Validation; 04/10/14
+1 ;;5.3;Scheduling;**620**;AUG 13, 1993;Build 11
+2 ;
ENTER ; Entry point
+1 ;
+2 ; Extract file will be a delimited text file (.TXT) that will provide information for PCMM data validation
+3 ; Delimiter is a pipe ("|") character
+4 ;
+5 ; FILE OUTPUT:
+6 ;
+7 ; STANUM - Station #
+8 ; TIEN - IEN of Team
+9 ; TNAME - Name of Team
+10 ; EFFDT - Effective Date
+11 ; STATUS - Status
+12 ; STATRSN - Status Reason
+13 ;
+14 NEW SCMCPATH,SCMCHFS,SCMCERR,MSG,SCMCMODE,IOF,SITE
+15 NEW SCDATA,SCIENS,STANUM,TIEN,TNAME,EFFDT,STATUS,STATRSN
+16 SET SITE=$$SITE^VASITE
SET STANUM=$PIECE(SITE,"^",3)
+17 SET SCMCPATH=$$DEFDIR^%ZISH()
SET SCMCHFS=STANUM_"_PCMMTEAMHISTORY.TXT"
SET SCMCERR=0
USE 0
WRITE !!,SCMCPATH
+18 DO HFSOPEN("SCMCRP",SCMCPATH,SCMCHFS,"W")
IF SCMCERR
GOTO END
+19 USE IO
+20 DO COLHDR
DO SETREC
GOTO END
+21 ;
SETREC ;$O through Team History file and find history for all teams
+1 SET TIEN=0
+2 FOR
SET TIEN=$ORDER(^SCTM(404.58,TIEN))
if TIEN=""!(TIEN'?.N)
QUIT
Begin DoDot:1
+3 KILL SCDATA
+4 SET SCIENS=+$GET(TIEN)_","
+5 DO GETS^DIQ(404.58,SCIENS,".01;.02;.03;.04","IE","SCDATA","")
+6 SET TNAME=$GET(SCDATA(404.58,SCIENS,.01,"E"))
+7 SET EFFDT=$GET(SCDATA(404.58,SCIENS,.02,"E"))
+8 SET STATUS=$GET(SCDATA(404.58,SCIENS,.03,"E"))
+9 SET STATRSN=$GET(SCDATA(404.58,SCIENS,.04,"E"))
+10 WRITE STANUM_"|"_TIEN_"|"_TNAME_"|"_EFFDT_"|"_STATUS_"|"_STATRSN,!
End DoDot:1
+11 QUIT
+12 ;
COLHDR ;Create column header for Team History extract file
+1 WRITE "Station #|Team History IEN|Team Name|Effective Date|Status|Status Reason",!
+2 QUIT
+3 ;
END DO HFSCLOSE("SCMCRP",SCMCHFS)
+1 NEW I
+2 ;Create pipe delimited output if no errors
IF '+SCMCERR
Begin DoDot:1
+3 SET MSG=$NAME(^TMP("SCMC",$JOB))
End DoDot:1
QUIT
+4 ;Replace "##FFFF##" with Form Feeds - code needed for LINUX environments
+5 SET I=0
FOR
SET I=$ORDER(^TMP("SCMC",$JOB,1,I))
if 'I
QUIT
Begin DoDot:1
+6 if ^TMP("SCMC",$JOB,1,I)["##FFFF##"
SET ^TMP("SCMC",$JOB,1,I)=$PIECE(^TMP("SCMC",$JOB,1,I),"##FFFF##")_$CHAR(13,12)_$PIECE(^TMP("SCMC",$JOB,1,I),"##FFFF##",2)
+7 SET ^TMP("SCMC",$JOB,1,I)=^TMP("SCMC",$JOB,1,I)_$CHAR(13)
+8 if ^TMP("SCMC",$JOB,1,I)["$END"
SET ^TMP("SCMC",$JOB,1,I)=""
End DoDot:1
+9 SET MSG=$NAME(^TMP("SCMC",$JOB))
+10 QUIT
+11 ;
HFSOPEN(HANDLE,SCMCPATH,SCMCHFS,SCMCMODE) ; Open File
+1 NEW POP
+2 DO OPEN^%ZISH(HANDLE,SCMCPATH,SCMCHFS,$GET(SCMCMODE,"W"))
if POP
Begin DoDot:1
+3 SET SCMCERR=1
SET ^TMP("SCMC",$JOB,1)="0^Unable to open file "
End DoDot:1
if POP
QUIT
+4 ;resets screen position and adds page break flag - added to deal with Linux environments.
SET IOF="$$IOF^SCRPTHST"
+5 QUIT
+6 ;
HFSCLOSE(HANDLE,SCMHFS) ;Close HFS and unload data
+1 DO CLOSE^%ZISH(HANDLE)
+2 QUIT
+3 ;
IOF() ;used to reset position and insert page break flag when @IOF is executed.
+1 SET $X=0
SET $Y=0
+2 QUIT "##FFFF##"_$CHAR(13,10)
+3 ;
