SCRPPRAH ;ALB/DJS - Preceptor Assignment History Extract for PCMMR Data Validation; 04/18/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 #
; PREAHIEN - IEN of Preceptor Assignment History
; TPIEN - IEN of Team Position
; TMPOS - Team Position
; EFFDT - Effective Date
; STATUS - Status
; STATRSN - Status Reason
; PRCTPIEN - IEN of Preceptor Team Position
; PRETMPOS - Preceptor Team Position
; DATEENT - Date/Time Entered
; PRECPTNM - Preceptor Name
;
N SCMCPATH,SCMCHFS,SCMCERR,SCMCMODE,MSG,IOF
N SCDATA,SCIENS,STANUM,PREAHIEN,TPIEN,TMPOS,EFFDT,STATUS,STATRSN,PRCTPIEN,PRETMPOS,DATEENT,PRECPTNM,SITE
S SITE=$$SITE^VASITE,STANUM=$P(SITE,"^",3)
S SCMCPATH=$$DEFDIR^%ZISH(),SCMCHFS=STANUM_"_PCMMPRECEPTORASSIGNMENTHISTORY.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 preceptor assignment history file
S PREAHIEN=0
F S PREAHIEN=$O(^SCTM(404.53,PREAHIEN)) Q:PREAHIEN=""!(PREAHIEN'?.N) D
.K SCDATA
.S SCIENS=+$G(PREAHIEN)_","
.D GETS^DIQ(404.53,SCIENS,".01;.02;.04;.05;.06;.07;.08;200","IE","SCDATA","")
.S TPIEN=$G(SCDATA(404.53,SCIENS,.01,"I"))
.S TMPOS=$G(SCDATA(404.53,SCIENS,.01,"E"))
.S EFFDT=$G(SCDATA(404.53,SCIENS,.02,"E"))
.S STATUS=$G(SCDATA(404.53,SCIENS,.04,"E"))
.S STATRSN=$G(SCDATA(404.53,SCIENS,.05,"E"))
.S PRCTPIEN=$G(SCDATA(404.53,SCIENS,.06,"I"))
.S PRETMPOS=$G(SCDATA(404.53,SCIENS,.06,"E"))
.S DATEENT=$G(SCDATA(404.53,SCIENS,.08,"E"))
.S PRECPTNM=$G(SCDATA(404.53,SCIENS,200,"E"))
.W STANUM_"|"_PREAHIEN_"|"_TPIEN_"|"_TMPOS_"|"_EFFDT_"|"_STATUS_"|"_STATRSN_"|"_PRCTPIEN_"|"_PRETMPOS_"|"_DATEENT_"|"_PRECPTNM,!
Q
;
COLHDR ;Create column header for Preceptor Assignment History extract file
W "Station #|Prec. Assign. Hist. IEN|Team Position IEN|Team Position|Effective Date|Status|Status Reason|Preceptor Team Position IEN|Preceptor Team Position|Date Entered|Preceptor Name",!
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^SCRPPRAH" ;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[HSCRPPRAH 3272 printed Apr 09, 2024@21:42:29 Page 2
SCRPPRAH ;ALB/DJS - Preceptor Assignment History Extract for PCMMR Data Validation; 04/18/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 ; PREAHIEN - IEN of Preceptor Assignment History
+9 ; TPIEN - IEN of Team Position
+10 ; TMPOS - Team Position
+11 ; EFFDT - Effective Date
+12 ; STATUS - Status
+13 ; STATRSN - Status Reason
+14 ; PRCTPIEN - IEN of Preceptor Team Position
+15 ; PRETMPOS - Preceptor Team Position
+16 ; DATEENT - Date/Time Entered
+17 ; PRECPTNM - Preceptor Name
+18 ;
+19 NEW SCMCPATH,SCMCHFS,SCMCERR,SCMCMODE,MSG,IOF
+20 NEW SCDATA,SCIENS,STANUM,PREAHIEN,TPIEN,TMPOS,EFFDT,STATUS,STATRSN,PRCTPIEN,PRETMPOS,DATEENT,PRECPTNM,SITE
+21 SET SITE=$$SITE^VASITE
SET STANUM=$PIECE(SITE,"^",3)
+22 SET SCMCPATH=$$DEFDIR^%ZISH()
SET SCMCHFS=STANUM_"_PCMMPRECEPTORASSIGNMENTHISTORY.TXT"
SET SCMCERR=0
USE 0
WRITE !!,SCMCPATH
+23 DO HFSOPEN("SCMCRP",SCMCPATH,SCMCHFS,"W")
IF SCMCERR
GOTO END
+24 USE IO
+25 DO COLHDR
DO SETREC
GOTO END
+26 ;
SETREC ;$O through preceptor assignment history file
+1 SET PREAHIEN=0
+2 FOR
SET PREAHIEN=$ORDER(^SCTM(404.53,PREAHIEN))
if PREAHIEN=""!(PREAHIEN'?.N)
QUIT
Begin DoDot:1
+3 KILL SCDATA
+4 SET SCIENS=+$GET(PREAHIEN)_","
+5 DO GETS^DIQ(404.53,SCIENS,".01;.02;.04;.05;.06;.07;.08;200","IE","SCDATA","")
+6 SET TPIEN=$GET(SCDATA(404.53,SCIENS,.01,"I"))
+7 SET TMPOS=$GET(SCDATA(404.53,SCIENS,.01,"E"))
+8 SET EFFDT=$GET(SCDATA(404.53,SCIENS,.02,"E"))
+9 SET STATUS=$GET(SCDATA(404.53,SCIENS,.04,"E"))
+10 SET STATRSN=$GET(SCDATA(404.53,SCIENS,.05,"E"))
+11 SET PRCTPIEN=$GET(SCDATA(404.53,SCIENS,.06,"I"))
+12 SET PRETMPOS=$GET(SCDATA(404.53,SCIENS,.06,"E"))
+13 SET DATEENT=$GET(SCDATA(404.53,SCIENS,.08,"E"))
+14 SET PRECPTNM=$GET(SCDATA(404.53,SCIENS,200,"E"))
+15 WRITE STANUM_"|"_PREAHIEN_"|"_TPIEN_"|"_TMPOS_"|"_EFFDT_"|"_STATUS_"|"_STATRSN_"|"_PRCTPIEN_"|"_PRETMPOS_"|"_DATEENT_"|"_PRECPTNM,!
End DoDot:1
+16 QUIT
+17 ;
COLHDR ;Create column header for Preceptor Assignment History extract file
+1 WRITE "Station #|Prec. Assign. Hist. IEN|Team Position IEN|Team Position|Effective Date|Status|Status Reason|Preceptor Team Position IEN|Preceptor Team Position|Date Entered|Preceptor Name",!
+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^SCRPPRAH"
+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 ;
