- 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 Feb 19, 2025@00:09:18 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 ;