SCRPPTA ;ALB/DJS - Patient Team Assignment 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 #
; PTAIEN - IEN of Patient Team Assigment
; PTIEN - IEN of Patient
; PTNAME - Patient Name
; PTDOB - Patient Date of Birth
; PTSSN - Patient SSN
; PTDOD - Patient Date of Death
; PTICN - Patient ICN
; ICNCHKSM - ICN Checksum
; LOCALICN - Locally Assigned ICN
; TMASGDT - Team Assigned Date
; TIEN - IEN of Team
; TANAME - Team Assignment Name
; ASGNTYPE - IEN of Assignment Type
; DISCHDT - Team Discharge Date
; STATUS - Status
;
N SCMCPATH,SCMCHFS,SCMCERR,SCMCMODE,MSG,IOF,SITE
N SCDATA,SCIENS,PTDATA,PTIENS,STANUM,PTAIEN,PTIEN,PTNAME,PTDOB,PTSSN
N PTDOD,PTICN,ICNCHKSM,LOCALICN,TMASGDT,TIEN,TANAME,ASGNTYPE,DISCHDT,STATUS
S SITE=$$SITE^VASITE,STANUM=$P(SITE,"^",3)
S SCMCPATH=$$DEFDIR^%ZISH(),SCMCHFS=STANUM_"_PCMMPATIENTTEAMASSIGNMENT.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 the patient team assignment file
S PTAIEN=0
F S PTAIEN=$O(^SCPT(404.42,PTAIEN)) Q:PTAIEN=""!(PTAIEN'?.N) D
.K SCDATA,PTDATA
.S SCIENS=+$G(PTAIEN)_","
.D GETS^DIQ(404.42,SCIENS,".01;.02;.03;.08;.09;.12;.14;.15","IE","SCDATA","")
.S PTIEN=$G(SCDATA(404.42,SCIENS,.01,"I")) Q:PTIEN=""
.S PTNAME=$G(SCDATA(404.42,SCIENS,.01,"E"))
.S TMASGDT=$$FMTE^XLFDT($G(SCDATA(404.42,SCIENS,.02,"I"),"5D"))
.S TIEN=$G(SCDATA(404.42,SCIENS,.03,"I"))
.S TANAME=$G(SCDATA(404.42,SCIENS,.03,"E"))
.S ASGNTYPE=$G(SCDATA(404.42,SCIENS,.08,"I"))
.S DISCHDT=$$FMTE^XLFDT($G(SCDATA(404.42,SCIENS,.09,"I"),"5D"))
.S STATUS=$G(SCDATA(404.42,SCIENS,.15,"E"))
.S PTIENS=+$G(PTIEN)_","
.D GETS^DIQ(2,PTIENS,".03;.09;.351;991.01;991.02;991.04","IE","PTDATA")
.S PTDOB=$G(PTDATA(2,PTIENS,.03,"E"))
.S PTSSN=$G(PTDATA(2,PTIENS,.09,"E"))
.S PTDOD=$$FMTE^XLFDT($G(PTDATA(2,PTIENS,.351,"I"),"5D"))
.S PTICN=$G(PTDATA(2,PTIENS,991.01,"E"))
.S ICNCHKSM=$G(PTDATA(2,PTIENS,991.02,"E"))
.S LOCALICN=$G(PTDATA(2,PTIENS,991.04,"E"))
.W STANUM_"|"_PTAIEN_"|"_PTIEN_"|"_PTNAME_"|"_PTDOB_"|"_PTSSN_"|"_PTDOD_"|"_PTICN_"|"_ICNCHKSM_"|"_LOCALICN_"|"_TMASGDT_"|"_TIEN_"|"_TANAME_"|"_ASGNTYPE_"|"_DISCHDT_"|"_STATUS,!
Q
;
COLHDR ;Create column header for Patient Team Assignment extract file
W "Station #|Pt. Team Assign IEN|Patient IEN|Patient Name|Date of Birth|SSN|Date of Death|ICN|ICN Checksum|Locally Assigned ICN|Team Assigned Date|Team IEN|Team Assignment|Assignment Type|Team Discharge Date|Status",!
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^SCRPPTA" ;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[HSCRPPTA 3874 printed Sep 23, 2025@20:19:12 Page 2
SCRPPTA ;ALB/DJS - Patient Team Assignment 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 ; PTAIEN - IEN of Patient Team Assigment
+9 ; PTIEN - IEN of Patient
+10 ; PTNAME - Patient Name
+11 ; PTDOB - Patient Date of Birth
+12 ; PTSSN - Patient SSN
+13 ; PTDOD - Patient Date of Death
+14 ; PTICN - Patient ICN
+15 ; ICNCHKSM - ICN Checksum
+16 ; LOCALICN - Locally Assigned ICN
+17 ; TMASGDT - Team Assigned Date
+18 ; TIEN - IEN of Team
+19 ; TANAME - Team Assignment Name
+20 ; ASGNTYPE - IEN of Assignment Type
+21 ; DISCHDT - Team Discharge Date
+22 ; STATUS - Status
+23 ;
+24 NEW SCMCPATH,SCMCHFS,SCMCERR,SCMCMODE,MSG,IOF,SITE
+25 NEW SCDATA,SCIENS,PTDATA,PTIENS,STANUM,PTAIEN,PTIEN,PTNAME,PTDOB,PTSSN
+26 NEW PTDOD,PTICN,ICNCHKSM,LOCALICN,TMASGDT,TIEN,TANAME,ASGNTYPE,DISCHDT,STATUS
+27 SET SITE=$$SITE^VASITE
SET STANUM=$PIECE(SITE,"^",3)
+28 SET SCMCPATH=$$DEFDIR^%ZISH()
SET SCMCHFS=STANUM_"_PCMMPATIENTTEAMASSIGNMENT.TXT"
SET SCMCERR=0
USE 0
WRITE !!,SCMCPATH
+29 DO HFSOPEN("SCMCRP",SCMCPATH,SCMCHFS,"W")
IF SCMCERR
GOTO END
+30 USE IO
+31 DO COLHDR
DO SETREC
GOTO END
+32 ;
SETREC ;$O through the patient team assignment file
+1 SET PTAIEN=0
+2 FOR
SET PTAIEN=$ORDER(^SCPT(404.42,PTAIEN))
if PTAIEN=""!(PTAIEN'?.N)
QUIT
Begin DoDot:1
+3 KILL SCDATA,PTDATA
+4 SET SCIENS=+$GET(PTAIEN)_","
+5 DO GETS^DIQ(404.42,SCIENS,".01;.02;.03;.08;.09;.12;.14;.15","IE","SCDATA","")
+6 SET PTIEN=$GET(SCDATA(404.42,SCIENS,.01,"I"))
if PTIEN=""
QUIT
+7 SET PTNAME=$GET(SCDATA(404.42,SCIENS,.01,"E"))
+8 SET TMASGDT=$$FMTE^XLFDT($GET(SCDATA(404.42,SCIENS,.02,"I"),"5D"))
+9 SET TIEN=$GET(SCDATA(404.42,SCIENS,.03,"I"))
+10 SET TANAME=$GET(SCDATA(404.42,SCIENS,.03,"E"))
+11 SET ASGNTYPE=$GET(SCDATA(404.42,SCIENS,.08,"I"))
+12 SET DISCHDT=$$FMTE^XLFDT($GET(SCDATA(404.42,SCIENS,.09,"I"),"5D"))
+13 SET STATUS=$GET(SCDATA(404.42,SCIENS,.15,"E"))
+14 SET PTIENS=+$GET(PTIEN)_","
+15 DO GETS^DIQ(2,PTIENS,".03;.09;.351;991.01;991.02;991.04","IE","PTDATA")
+16 SET PTDOB=$GET(PTDATA(2,PTIENS,.03,"E"))
+17 SET PTSSN=$GET(PTDATA(2,PTIENS,.09,"E"))
+18 SET PTDOD=$$FMTE^XLFDT($GET(PTDATA(2,PTIENS,.351,"I"),"5D"))
+19 SET PTICN=$GET(PTDATA(2,PTIENS,991.01,"E"))
+20 SET ICNCHKSM=$GET(PTDATA(2,PTIENS,991.02,"E"))
+21 SET LOCALICN=$GET(PTDATA(2,PTIENS,991.04,"E"))
+22 WRITE STANUM_"|"_PTAIEN_"|"_PTIEN_"|"_PTNAME_"|"_PTDOB_"|"_PTSSN_"|"_PTDOD_"|"_PTICN_"|"_ICNCHKSM_"|"_LOCALICN_"|"_TMASGDT_"|"_TIEN_"|"_TANAME_"|"_ASGNTYPE_"|"_DISCHDT_"|"_STATUS,!
End DoDot:1
+23 QUIT
+24 ;
COLHDR ;Create column header for Patient Team Assignment extract file
+1 WRITE "Station #|Pt. Team Assign IEN|Patient IEN|Patient Name|Date of Birth|SSN|Date of Death|ICN|ICN Checksum|Locally Assigned ICN|Team Assigned Date|Team IEN|Team Assignment|Assignment Type|Team Discharge Date|Status",!
+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^SCRPPTA"
+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 ;
