SCRPPTPA ;ALB/DJS - Patient Team Position Assignment Extract for PCMMR Data Validation; 04/11/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 #
; PTPAIEN - IEN of Patient Team Position Assignment
; PTASGIEN - IEN of Patient Team Assignment
; PTASGN - Patient Team Assignment
; TMPOSIEN - IEN of Team Position
; TMPOS - Team Position
; POSASDT - Position Assigned Date
; POUNADT - Position Unassigned Date
; PCROLE - PC Role
; STATUS - Status
; EXTAUINA - Extend Automatic Inactivation
; EXTCMMNT - Extension Comment
; DT4INACT - Date Flagged for Inactivation
; SCHINADT - Scheduled Inactivation Date
; EXTBYIEN - IEN of Extended By value (ptr. to New Person file #200)
; EXTENDBY - Extended By
; DTDISINA - Date Disinactivated
;
N SCMCPATH,SCMCHFS,SCMCERR,SCMCMODE,MSG,IOF,SITE
N SCDATA,SCIENS,STANUM,PTPAIEN,PTASGIEN,PTASGN,TMPOSIEN,TMPOS,POSASDT,POUNADT
N PCROLE,STATUS,EXTAUINA,EXTCMMNT,DT4INACT,SCHINADT,EXTBYIEN,EXTENDBY,DTDISINA
S SITE=$$SITE^VASITE,STANUM=$P(SITE,"^",3)
S SCMCPATH=$$DEFDIR^%ZISH(),SCMCHFS=STANUM_"_PCMMPATIENTTEAMPOSITIONASSIGNMENT.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 patient team position assignment file
S PTPAIEN=0
F S PTPAIEN=$O(^SCPT(404.43,PTPAIEN)) Q:PTPAIEN=""!(PTPAIEN'?.N) D
.K SCDATA
.S SCIENS=+$G(PTPAIEN)_","
.D GETS^DIQ(404.43,SCIENS,".01;.02;.03;.04;.05;.12;.13;.14;.15;.159;.16;.17","IE","SCDATA","")
.S PTASGIEN=$G(SCDATA(404.43,SCIENS,.01,"I"))
.S PTASGN=$G(SCDATA(404.43,SCIENS,.01,"E"))
.S TMPOSIEN=$G(SCDATA(404.43,SCIENS,.02,"I"))
.S TMPOS=$G(SCDATA(404.43,SCIENS,.02,"E"))
.S POSASDT=$G(SCDATA(404.43,SCIENS,.03,"E"))
.S POUNADT=$G(SCDATA(404.43,SCIENS,.04,"E"))
.S PCROLE=$G(SCDATA(404.43,SCIENS,.05,"E"))
.S STATUS=$G(SCDATA(404.43,SCIENS,.12,"E"))
.S EXTAUINA=$G(SCDATA(404.43,SCIENS,.13,"E"))
.S EXTCMMNT=$G(SCDATA(404.43,SCIENS,.14,"E"))
.S DT4INACT=$G(SCDATA(404.43,SCIENS,.15,"E"))
.S SCHINADT=$G(SCDATA(404.43,SCIENS,.159,"E"))
.S EXTBYIEN=$G(SCDATA(404.43,SCIENS,.16,"I"))
.S EXTENDBY=$G(SCDATA(404.43,SCIENS,.16,"E"))
.S DTDISINA=$G(SCDATA(404.43,SCIENS,.17,"E"))
.W STANUM_"|"_PTPAIEN_"|"_PTASGIEN_"|"_PTASGN_"|"_TMPOSIEN_"|"_TMPOS_"|"_POSASDT_"|"_POUNADT_"|"_PCROLE_"|"_STATUS_"|"_EXTAUINA_"|"_EXTCMMNT_"|"_DT4INACT_"|"_SCHINADT_"|"_EXTBYIEN_"|"_EXTENDBY_"|"_DTDISINA,!
Q
;
COLHDR ;Create column header for Patient Team Position Assignment extract file
W "Station #|Pt. Team Pos. Assign. IEN|Patient Team Assignment IEN|Patient Team Assignment|Team Position IEN|Team Position|Position Assigned Date|Position Unassigned Date|PC Role|"
W "Status|Extend Automatic Inactivation|Extension Comment|Date Flagged for Inactivation|Scheduled Inactivation Date|Extended By IEN|Extended By|Date Disinactivated",!
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^SCRPPTPA" ;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[HSCRPPTPA 4172 printed Apr 09, 2024@21:53:29 Page 2
SCRPPTPA ;ALB/DJS - Patient Team Position Assignment Extract for PCMMR Data Validation; 04/11/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 ; PTPAIEN - IEN of Patient Team Position Assignment
+9 ; PTASGIEN - IEN of Patient Team Assignment
+10 ; PTASGN - Patient Team Assignment
+11 ; TMPOSIEN - IEN of Team Position
+12 ; TMPOS - Team Position
+13 ; POSASDT - Position Assigned Date
+14 ; POUNADT - Position Unassigned Date
+15 ; PCROLE - PC Role
+16 ; STATUS - Status
+17 ; EXTAUINA - Extend Automatic Inactivation
+18 ; EXTCMMNT - Extension Comment
+19 ; DT4INACT - Date Flagged for Inactivation
+20 ; SCHINADT - Scheduled Inactivation Date
+21 ; EXTBYIEN - IEN of Extended By value (ptr. to New Person file #200)
+22 ; EXTENDBY - Extended By
+23 ; DTDISINA - Date Disinactivated
+24 ;
+25 NEW SCMCPATH,SCMCHFS,SCMCERR,SCMCMODE,MSG,IOF,SITE
+26 NEW SCDATA,SCIENS,STANUM,PTPAIEN,PTASGIEN,PTASGN,TMPOSIEN,TMPOS,POSASDT,POUNADT
+27 NEW PCROLE,STATUS,EXTAUINA,EXTCMMNT,DT4INACT,SCHINADT,EXTBYIEN,EXTENDBY,DTDISINA
+28 SET SITE=$$SITE^VASITE
SET STANUM=$PIECE(SITE,"^",3)
+29 SET SCMCPATH=$$DEFDIR^%ZISH()
SET SCMCHFS=STANUM_"_PCMMPATIENTTEAMPOSITIONASSIGNMENT.TXT"
SET SCMCERR=0
USE 0
WRITE !!,SCMCPATH
+30 DO HFSOPEN("SCMCRP",SCMCPATH,SCMCHFS,"W")
IF SCMCERR
GOTO END
+31 USE IO
+32 DO COLHDR
DO SETREC
GOTO END
+33 ;
SETREC ;$O through patient team position assignment file
+1 SET PTPAIEN=0
+2 FOR
SET PTPAIEN=$ORDER(^SCPT(404.43,PTPAIEN))
if PTPAIEN=""!(PTPAIEN'?.N)
QUIT
Begin DoDot:1
+3 KILL SCDATA
+4 SET SCIENS=+$GET(PTPAIEN)_","
+5 DO GETS^DIQ(404.43,SCIENS,".01;.02;.03;.04;.05;.12;.13;.14;.15;.159;.16;.17","IE","SCDATA","")
+6 SET PTASGIEN=$GET(SCDATA(404.43,SCIENS,.01,"I"))
+7 SET PTASGN=$GET(SCDATA(404.43,SCIENS,.01,"E"))
+8 SET TMPOSIEN=$GET(SCDATA(404.43,SCIENS,.02,"I"))
+9 SET TMPOS=$GET(SCDATA(404.43,SCIENS,.02,"E"))
+10 SET POSASDT=$GET(SCDATA(404.43,SCIENS,.03,"E"))
+11 SET POUNADT=$GET(SCDATA(404.43,SCIENS,.04,"E"))
+12 SET PCROLE=$GET(SCDATA(404.43,SCIENS,.05,"E"))
+13 SET STATUS=$GET(SCDATA(404.43,SCIENS,.12,"E"))
+14 SET EXTAUINA=$GET(SCDATA(404.43,SCIENS,.13,"E"))
+15 SET EXTCMMNT=$GET(SCDATA(404.43,SCIENS,.14,"E"))
+16 SET DT4INACT=$GET(SCDATA(404.43,SCIENS,.15,"E"))
+17 SET SCHINADT=$GET(SCDATA(404.43,SCIENS,.159,"E"))
+18 SET EXTBYIEN=$GET(SCDATA(404.43,SCIENS,.16,"I"))
+19 SET EXTENDBY=$GET(SCDATA(404.43,SCIENS,.16,"E"))
+20 SET DTDISINA=$GET(SCDATA(404.43,SCIENS,.17,"E"))
+21 WRITE STANUM_"|"_PTPAIEN_"|"_PTASGIEN_"|"_PTASGN_"|"_TMPOSIEN_"|"_TMPOS_"|"_POSASDT_"|"_POUNADT_"|"_PCROLE_"|"_STATUS_"|"_EXTAUINA_"|"_EXTCMMNT_"|"_DT4INACT_"|"_SCHINADT_"|"_EXTBYIEN_"|"_EXTENDBY_"|"_DTDISINA,!
End DoDot:1
+22 QUIT
+23 ;
COLHDR ;Create column header for Patient Team Position Assignment extract file
+1 WRITE "Station #|Pt. Team Pos. Assign. IEN|Patient Team Assignment IEN|Patient Team Assignment|Team Position IEN|Team Position|Position Assigned Date|Position Unassigned Date|PC Role|"
+2 WRITE "Status|Extend Automatic Inactivation|Extension Comment|Date Flagged for Inactivation|Scheduled Inactivation Date|Extended By IEN|Extended By|Date Disinactivated",!
+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^SCRPPTPA"
+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 ;
