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.  ;