Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SCRPTEAM

SCRPTEAM.m

Go to the documentation of this file.
  1. SCRPTEAM ;ALB/DJS - Team Listing Extract for PCMMR Data Validation; 04/03/14
  1. ;;5.3;Scheduling;**620**;AUG 13, 1993;Build 11
  1. ;
  1. ENTER ; Entry point
  1. ;
  1. ; Extract file will be a delimited text file (.TXT) that will provide information for PCMM data validation
  1. ; Delimiter is a pipe ("|") character
  1. ;
  1. ; FILE OUTPUT:
  1. ;
  1. ; STANUM - Station #
  1. ; TIEN - IEN of team
  1. ; TNAME - Name of Team
  1. ; TPURPIEN - Team Purpose IEN POINTER TO TEAM PURPOSE FILE (#403.47)
  1. ; TPURP - Team Purpose
  1. ; ACTASPC - Can Act as a PC Team == 0 or 1
  1. ; TINST - Institution Name
  1. ; STANUM - Station # POINTER TO INSTITUTION FILE (#4)
  1. ; MAXPT - Max # of Patients
  1. ; CLS2ASGN - Close to Further Assignment == 0 or 1
  1. ; CURPTS - Current # of Patients
  1. ; CURSTAT - Current Status == Active or Inactive
  1. ; CUREFFDT - Current Effective Date
  1. ; CURACTDT - Current Activation Date
  1. ; CURINADT - Current Inactivation Date
  1. ;
  1. N SCMCPATH,SCMCHFS,SCMCERR,MSG,SCMCMODE,IOF,SCIENS,SITE,STANUM
  1. N SCDATA,TIEN,TNAME,TPURPIEN,TPURP,ACTASPC,TINST,MAXPT,CLS2ASGN,CURPTS,CURSTAT,CUREFFDT,CURACTDT,CURINADT
  1. S SITE=$$SITE^VASITE,STANUM=$P(SITE,"^",3)
  1. S SCMCPATH=$$DEFDIR^%ZISH(),SCMCHFS=STANUM_"_PCMMTEAM.TXT",SCMCERR=0 U 0 W !!,SCMCPATH
  1. D HFSOPEN("SCMCRP",SCMCPATH,SCMCHFS,"W") I SCMCERR G END
  1. U IO
  1. D COLHDR,SETREC G END
  1. ;
  1. SETREC ;$O through team file and find all teams
  1. S TIEN=0
  1. F S TIEN=$O(^SCTM(404.51,TIEN)) Q:TIEN=""!(TIEN'?.N) D
  1. .K SCDATA
  1. .S SCIENS=+$G(TIEN)_","
  1. .D GETS^DIQ(404.51,SCIENS,".01;.02;.03;.05;.06;.07;.08;.09;.1;201;202;203;204;205","IE","SCDATA","")
  1. .S TNAME=$G(SCDATA(404.51,SCIENS,.01,"E"))
  1. .S TPURPIEN=$G(SCDATA(404.51,SCIENS,.03,"I"))
  1. .S TPURP=$G(SCDATA(404.51,SCIENS,.03,"E"))
  1. .S ACTASPC=$G(SCDATA(404.51,SCIENS,.05,"E"))
  1. .S TINST=$G(SCDATA(404.51,SCIENS,.07,"E"))
  1. .S MAXPT=$G(SCDATA(404.51,SCIENS,.08,"E"))
  1. .S CLS2ASGN=$G(SCDATA(404.51,SCIENS,.1,"E"))
  1. .S CURPTS=$G(SCDATA(404.51,SCIENS,201,"E"))
  1. .S CURSTAT=$G(SCDATA(404.51,SCIENS,202,"E"))
  1. .S CUREFFDT=$G(SCDATA(404.51,SCIENS,203,"E"))
  1. .S CURACTDT=$G(SCDATA(404.51,SCIENS,204,"E"))
  1. .S CURINADT=$G(SCDATA(404.51,SCIENS,205,"E"))
  1. .W STANUM_"|"_TIEN_"|"_TNAME_"|"_TPURPIEN_"|"_TPURP_"|"_ACTASPC_"|"_TINST_"|"_MAXPT_"|"_CLS2ASGN_"|"_CURPTS_"|"_CURSTAT_"|"_CUREFFDT_"|"_CURACTDT_"|"_CURINADT,!
  1. Q
  1. ;
  1. COLHDR ;Create column header for Team extract file
  1. W "Station #|Team IEN|Team Name|Team Purpose IEN|Team Purpose|Act as a PC Team?|Institution|Max # Patients|Close to Assignment|"
  1. W "Current # Patients|Current Status|Current Effective Date|Current Activation Date|Current Inactivation Date",!
  1. Q
  1. ;
  1. END D HFSCLOSE("SCMCRP",SCMCHFS)
  1. N I
  1. I '+SCMCERR D Q ;Create pipe delimited output if no errors
  1. .S MSG=$NA(^TMP("SCMC",$J))
  1. ;Replace "##FFFF##" with Form Feeds - code needed for LINUX environments
  1. S I=0 F S I=$O(^TMP("SCMC",$J,1,I)) Q:'I D
  1. .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)
  1. .S ^TMP("SCMC",$J,1,I)=^TMP("SCMC",$J,1,I)_$C(13)
  1. .S:^TMP("SCMC",$J,1,I)["$END" ^TMP("SCMC",$J,1,I)=""
  1. S MSG=$NA(^TMP("SCMC",$J))
  1. Q
  1. ;
  1. HFSOPEN(HANDLE,SCMCPATH,SCMCHFS,SCMCMODE) ; Open File
  1. N POP
  1. D OPEN^%ZISH(HANDLE,SCMCPATH,SCMCHFS,$G(SCMCMODE,"W")) D:POP Q:POP
  1. .S SCMCERR=1,^TMP("SCMC",$J,1)="0^Unable to open file "
  1. S IOF="$$IOF^SCRPTEAM" ;resets screen position and adds page break flag - added to deal with Linux environments.
  1. Q
  1. ;
  1. HFSCLOSE(HANDLE,SCMHFS) ;Close HFS and unload data
  1. D CLOSE^%ZISH(HANDLE)
  1. Q
  1. ;
  1. IOF() ;used to reset position and insert page break flag when @IOF is executed.
  1. S $X=0,$Y=0
  1. Q "##FFFF##"_$C(13,10)
  1. ;