SCRPTEAM ;ALB/DJS - Team Listing Extract for PCMMR Data Validation; 04/03/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
; TPURPIEN - Team Purpose IEN POINTER TO TEAM PURPOSE FILE (#403.47)
; TPURP - Team Purpose
; ACTASPC - Can Act as a PC Team == 0 or 1
; TINST - Institution Name
; STANUM - Station # POINTER TO INSTITUTION FILE (#4)
; MAXPT - Max # of Patients
; CLS2ASGN - Close to Further Assignment == 0 or 1
; CURPTS - Current # of Patients
; CURSTAT - Current Status == Active or Inactive
; CUREFFDT - Current Effective Date
; CURACTDT - Current Activation Date
; CURINADT - Current Inactivation Date
;
N SCMCPATH,SCMCHFS,SCMCERR,MSG,SCMCMODE,IOF,SCIENS,SITE,STANUM
N SCDATA,TIEN,TNAME,TPURPIEN,TPURP,ACTASPC,TINST,MAXPT,CLS2ASGN,CURPTS,CURSTAT,CUREFFDT,CURACTDT,CURINADT
S SITE=$$SITE^VASITE,STANUM=$P(SITE,"^",3)
S SCMCPATH=$$DEFDIR^%ZISH(),SCMCHFS=STANUM_"_PCMMTEAM.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 file and find all teams
S TIEN=0
F S TIEN=$O(^SCTM(404.51,TIEN)) Q:TIEN=""!(TIEN'?.N) D
.K SCDATA
.S SCIENS=+$G(TIEN)_","
.D GETS^DIQ(404.51,SCIENS,".01;.02;.03;.05;.06;.07;.08;.09;.1;201;202;203;204;205","IE","SCDATA","")
.S TNAME=$G(SCDATA(404.51,SCIENS,.01,"E"))
.S TPURPIEN=$G(SCDATA(404.51,SCIENS,.03,"I"))
.S TPURP=$G(SCDATA(404.51,SCIENS,.03,"E"))
.S ACTASPC=$G(SCDATA(404.51,SCIENS,.05,"E"))
.S TINST=$G(SCDATA(404.51,SCIENS,.07,"E"))
.S MAXPT=$G(SCDATA(404.51,SCIENS,.08,"E"))
.S CLS2ASGN=$G(SCDATA(404.51,SCIENS,.1,"E"))
.S CURPTS=$G(SCDATA(404.51,SCIENS,201,"E"))
.S CURSTAT=$G(SCDATA(404.51,SCIENS,202,"E"))
.S CUREFFDT=$G(SCDATA(404.51,SCIENS,203,"E"))
.S CURACTDT=$G(SCDATA(404.51,SCIENS,204,"E"))
.S CURINADT=$G(SCDATA(404.51,SCIENS,205,"E"))
.W STANUM_"|"_TIEN_"|"_TNAME_"|"_TPURPIEN_"|"_TPURP_"|"_ACTASPC_"|"_TINST_"|"_MAXPT_"|"_CLS2ASGN_"|"_CURPTS_"|"_CURSTAT_"|"_CUREFFDT_"|"_CURACTDT_"|"_CURINADT,!
Q
;
COLHDR ;Create column header for Team extract file
W "Station #|Team IEN|Team Name|Team Purpose IEN|Team Purpose|Act as a PC Team?|Institution|Max # Patients|Close to Assignment|"
W "Current # Patients|Current Status|Current Effective Date|Current Activation Date|Current Inactivation Date",!
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^SCRPTEAM" ;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[HSCRPTEAM 3684 printed Apr 09, 2024@22:01:55 Page 2
SCRPTEAM ;ALB/DJS - Team Listing Extract for PCMMR Data Validation; 04/03/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 ; TPURPIEN - Team Purpose IEN POINTER TO TEAM PURPOSE FILE (#403.47)
+11 ; TPURP - Team Purpose
+12 ; ACTASPC - Can Act as a PC Team == 0 or 1
+13 ; TINST - Institution Name
+14 ; STANUM - Station # POINTER TO INSTITUTION FILE (#4)
+15 ; MAXPT - Max # of Patients
+16 ; CLS2ASGN - Close to Further Assignment == 0 or 1
+17 ; CURPTS - Current # of Patients
+18 ; CURSTAT - Current Status == Active or Inactive
+19 ; CUREFFDT - Current Effective Date
+20 ; CURACTDT - Current Activation Date
+21 ; CURINADT - Current Inactivation Date
+22 ;
+23 NEW SCMCPATH,SCMCHFS,SCMCERR,MSG,SCMCMODE,IOF,SCIENS,SITE,STANUM
+24 NEW SCDATA,TIEN,TNAME,TPURPIEN,TPURP,ACTASPC,TINST,MAXPT,CLS2ASGN,CURPTS,CURSTAT,CUREFFDT,CURACTDT,CURINADT
+25 SET SITE=$$SITE^VASITE
SET STANUM=$PIECE(SITE,"^",3)
+26 SET SCMCPATH=$$DEFDIR^%ZISH()
SET SCMCHFS=STANUM_"_PCMMTEAM.TXT"
SET SCMCERR=0
USE 0
WRITE !!,SCMCPATH
+27 DO HFSOPEN("SCMCRP",SCMCPATH,SCMCHFS,"W")
IF SCMCERR
GOTO END
+28 USE IO
+29 DO COLHDR
DO SETREC
GOTO END
+30 ;
SETREC ;$O through team file and find all teams
+1 SET TIEN=0
+2 FOR
SET TIEN=$ORDER(^SCTM(404.51,TIEN))
if TIEN=""!(TIEN'?.N)
QUIT
Begin DoDot:1
+3 KILL SCDATA
+4 SET SCIENS=+$GET(TIEN)_","
+5 DO GETS^DIQ(404.51,SCIENS,".01;.02;.03;.05;.06;.07;.08;.09;.1;201;202;203;204;205","IE","SCDATA","")
+6 SET TNAME=$GET(SCDATA(404.51,SCIENS,.01,"E"))
+7 SET TPURPIEN=$GET(SCDATA(404.51,SCIENS,.03,"I"))
+8 SET TPURP=$GET(SCDATA(404.51,SCIENS,.03,"E"))
+9 SET ACTASPC=$GET(SCDATA(404.51,SCIENS,.05,"E"))
+10 SET TINST=$GET(SCDATA(404.51,SCIENS,.07,"E"))
+11 SET MAXPT=$GET(SCDATA(404.51,SCIENS,.08,"E"))
+12 SET CLS2ASGN=$GET(SCDATA(404.51,SCIENS,.1,"E"))
+13 SET CURPTS=$GET(SCDATA(404.51,SCIENS,201,"E"))
+14 SET CURSTAT=$GET(SCDATA(404.51,SCIENS,202,"E"))
+15 SET CUREFFDT=$GET(SCDATA(404.51,SCIENS,203,"E"))
+16 SET CURACTDT=$GET(SCDATA(404.51,SCIENS,204,"E"))
+17 SET CURINADT=$GET(SCDATA(404.51,SCIENS,205,"E"))
+18 WRITE STANUM_"|"_TIEN_"|"_TNAME_"|"_TPURPIEN_"|"_TPURP_"|"_ACTASPC_"|"_TINST_"|"_MAXPT_"|"_CLS2ASGN_"|"_CURPTS_"|"_CURSTAT_"|"_CUREFFDT_"|"_CURACTDT_"|"_CURINADT,!
End DoDot:1
+19 QUIT
+20 ;
COLHDR ;Create column header for Team extract file
+1 WRITE "Station #|Team IEN|Team Name|Team Purpose IEN|Team Purpose|Act as a PC Team?|Institution|Max # Patients|Close to Assignment|"
+2 WRITE "Current # Patients|Current Status|Current Effective Date|Current Activation Date|Current Inactivation Date",!
+3 QUIT
+4 ;
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^SCRPTEAM"
+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 ;
