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

SCRPPTA.m

Go to the documentation of this file.
  1. SCRPPTA ;ALB/DJS - Patient Team Assignment 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. ; PTAIEN - IEN of Patient Team Assigment
  1. ; PTIEN - IEN of Patient
  1. ; PTNAME - Patient Name
  1. ; PTDOB - Patient Date of Birth
  1. ; PTSSN - Patient SSN
  1. ; PTDOD - Patient Date of Death
  1. ; PTICN - Patient ICN
  1. ; ICNCHKSM - ICN Checksum
  1. ; LOCALICN - Locally Assigned ICN
  1. ; TMASGDT - Team Assigned Date
  1. ; TIEN - IEN of Team
  1. ; TANAME - Team Assignment Name
  1. ; ASGNTYPE - IEN of Assignment Type
  1. ; DISCHDT - Team Discharge Date
  1. ; STATUS - Status
  1. ;
  1. N SCMCPATH,SCMCHFS,SCMCERR,SCMCMODE,MSG,IOF,SITE
  1. N SCDATA,SCIENS,PTDATA,PTIENS,STANUM,PTAIEN,PTIEN,PTNAME,PTDOB,PTSSN
  1. N PTDOD,PTICN,ICNCHKSM,LOCALICN,TMASGDT,TIEN,TANAME,ASGNTYPE,DISCHDT,STATUS
  1. S SITE=$$SITE^VASITE,STANUM=$P(SITE,"^",3)
  1. S SCMCPATH=$$DEFDIR^%ZISH(),SCMCHFS=STANUM_"_PCMMPATIENTTEAMASSIGNMENT.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 the patient team assignment file
  1. S PTAIEN=0
  1. F S PTAIEN=$O(^SCPT(404.42,PTAIEN)) Q:PTAIEN=""!(PTAIEN'?.N) D
  1. .K SCDATA,PTDATA
  1. .S SCIENS=+$G(PTAIEN)_","
  1. .D GETS^DIQ(404.42,SCIENS,".01;.02;.03;.08;.09;.12;.14;.15","IE","SCDATA","")
  1. .S PTIEN=$G(SCDATA(404.42,SCIENS,.01,"I")) Q:PTIEN=""
  1. .S PTNAME=$G(SCDATA(404.42,SCIENS,.01,"E"))
  1. .S TMASGDT=$$FMTE^XLFDT($G(SCDATA(404.42,SCIENS,.02,"I"),"5D"))
  1. .S TIEN=$G(SCDATA(404.42,SCIENS,.03,"I"))
  1. .S TANAME=$G(SCDATA(404.42,SCIENS,.03,"E"))
  1. .S ASGNTYPE=$G(SCDATA(404.42,SCIENS,.08,"I"))
  1. .S DISCHDT=$$FMTE^XLFDT($G(SCDATA(404.42,SCIENS,.09,"I"),"5D"))
  1. .S STATUS=$G(SCDATA(404.42,SCIENS,.15,"E"))
  1. .S PTIENS=+$G(PTIEN)_","
  1. .D GETS^DIQ(2,PTIENS,".03;.09;.351;991.01;991.02;991.04","IE","PTDATA")
  1. .S PTDOB=$G(PTDATA(2,PTIENS,.03,"E"))
  1. .S PTSSN=$G(PTDATA(2,PTIENS,.09,"E"))
  1. .S PTDOD=$$FMTE^XLFDT($G(PTDATA(2,PTIENS,.351,"I"),"5D"))
  1. .S PTICN=$G(PTDATA(2,PTIENS,991.01,"E"))
  1. .S ICNCHKSM=$G(PTDATA(2,PTIENS,991.02,"E"))
  1. .S LOCALICN=$G(PTDATA(2,PTIENS,991.04,"E"))
  1. .W STANUM_"|"_PTAIEN_"|"_PTIEN_"|"_PTNAME_"|"_PTDOB_"|"_PTSSN_"|"_PTDOD_"|"_PTICN_"|"_ICNCHKSM_"|"_LOCALICN_"|"_TMASGDT_"|"_TIEN_"|"_TANAME_"|"_ASGNTYPE_"|"_DISCHDT_"|"_STATUS,!
  1. Q
  1. ;
  1. COLHDR ;Create column header for Patient Team Assignment extract file
  1. 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",!
  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^SCRPPTA" ;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. ;