- 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 Feb 19, 2025@00:09:26 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 ;