SCRPTHST.m

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 ---SCRPTHST   2536     printed  Feb 19, 2025@00:09:27                                                                                                                                                                                                    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       ;