SCRPPAHS ;ALB/DJS - Position Assignment History Extract for PCMMR Data Validation; 04/18/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 #
; POSAHIEN - IEN of Position Assignment History
; TPIEN - IEN of Team Position
; TMPOS - Team Position
; EFFDT - Effective Date
; PRACTIEN - IEN of Practitioner
; PRACTNR - Practitioner
; STATUS - Status
; STATRSN - Status Reason
; FTEEEQU - FTEE Equivalent
; DT4INACT - Date for Inactivation
; AVAILPOS - Available Positions
; MAXPT - Max # of Patients
; CURACTPT - Current Active Patients
; ADJPANEL - Adjusted Panel Size
; AUTINACT - Inactivated Automatically
; FTEEHST - FTEE History
;
N SCMCPATH,SCMCHFS,SCMCERR,SCMCMODE,MSG,IOF
N SITE,SCDATA,SCIENS,STANUM,POSAHIEN,TPIEN,TMPOS,EFFDT,PRACTIEN,PRACTNR,STATUS,DATE,ENTRY,POP
N STATRSN,FTEEEQU,DT4INACT,AVAILPOS,MAXPT,CURACTPT,ADJPANEL,AUTINACT,FTEEHST,FTEEDAT,FTEEVAL
S SITE=$$SITE^VASITE,STANUM=$P(SITE,"^",3)
S SCMCPATH=$$DEFDIR^%ZISH(),SCMCHFS=STANUM_"_PCMMPOSITIONASSIGNMENTHISTORY.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 position assignment history file
S POSAHIEN=0
F S POSAHIEN=$O(^SCTM(404.52,POSAHIEN)) Q:POSAHIEN=""!(POSAHIEN'?.N) D
.K SCDATA
.S SCIENS=+$G(POSAHIEN)_","
.D GETS^DIQ(404.52,SCIENS,".01;.02;.03;.04;.05;.07;.08;.09;.091;.096;.097;.098;.099;.11","IE","SCDATA","")
.S TPIEN=$G(SCDATA(404.52,SCIENS,.01,"I"))
.S TMPOS=$G(SCDATA(404.52,SCIENS,.01,"E"))
.S EFFDT=$G(SCDATA(404.52,SCIENS,.02,"E"))
.S PRACTIEN=$G(SCDATA(404.52,SCIENS,.03,"I"))
.S PRACTNR=$G(SCDATA(404.52,SCIENS,.03,"E"))
.S STATUS=$G(SCDATA(404.52,SCIENS,.04,"E"))
.S STATRSN=$G(SCDATA(404.52,SCIENS,.05,"E"))
.S FTEEEQU=$G(SCDATA(404.52,SCIENS,.09,"E"))
.S DT4INACT=$G(SCDATA(404.52,SCIENS,.091,"E"))
.S AVAILPOS=$G(SCDATA(404.52,SCIENS,.096,"E"))
.S MAXPT=$G(SCDATA(404.52,SCIENS,.097,"E"))
.S CURACTPT=$G(SCDATA(404.52,SCIENS,.098,"E"))
.S ADJPANEL=$G(SCDATA(404.52,SCIENS,.099,"E"))
.S AUTINACT=$G(SCDATA(404.52,SCIENS,.11,"I"))
.S FTEEHST=$S($D(^SCTM(404.52,POSAHIEN,1,0)):1,1:"") I FTEEHST S ENTRY=0 D
..F S ENTRY=$O(^SCTM(404.52,POSAHIEN,1,ENTRY)) Q:ENTRY=""!(ENTRY'?.N) D
...S FTEEDAT=$P(^SCTM(404.52,POSAHIEN,1,ENTRY,0),"^"),DATE=$$FMTE^XLFDT(FTEEDAT,1)
...S FTEEVAL=$P(^SCTM(404.52,POSAHIEN,1,ENTRY,0),"^",2)
...S WRTLN(ENTRY)="|"_DATE_"|"_FTEEVAL
...Q
.W STANUM_"|"_POSAHIEN_"|"_TPIEN_"|"_TMPOS_"|"_EFFDT_"|"_PRACTIEN_"|"_PRACTNR_"|"_STATUS_"|"_STATRSN_"|"_FTEEEQU_"|"_DT4INACT_"|"_AVAILPOS_"|"_MAXPT_"|"_CURACTPT_"|"_ADJPANEL_"|"_AUTINACT I 'FTEEHST W !
.I FTEEHST F I=1:1 Q:'$D(WRTLN(I)) D
..W:I>1 STANUM_"|||||||||||||||" W WRTLN(I),!
.K FTEEHST,WRTLN,I
.Q
Q
;
COLHDR ;Create column header for Position Assignment History extract file
W "Station #|Pos. Assign. History IEN|Team Position IEN|Team Position|Effective Date|Practitioner IEN|Practitioner|Status|Status Reason|FTEE Equivalent|Date Flagged for Inactivation|"
W "Available Positions|Max # of Patients|Current Active Patients|Adjusted Panel Size|Inactivated Automatically|FTEE Date|FTEE Value",!
Q
;
END D HFSCLOSE("SCMCRP",SCMCHFS)
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
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^SCRPPAHS" ;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[HSCRPPAHS 4457 printed Apr 09, 2024@21:47:51 Page 2
SCRPPAHS ;ALB/DJS - Position Assignment History Extract for PCMMR Data Validation; 04/18/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 ; POSAHIEN - IEN of Position Assignment History
+9 ; TPIEN - IEN of Team Position
+10 ; TMPOS - Team Position
+11 ; EFFDT - Effective Date
+12 ; PRACTIEN - IEN of Practitioner
+13 ; PRACTNR - Practitioner
+14 ; STATUS - Status
+15 ; STATRSN - Status Reason
+16 ; FTEEEQU - FTEE Equivalent
+17 ; DT4INACT - Date for Inactivation
+18 ; AVAILPOS - Available Positions
+19 ; MAXPT - Max # of Patients
+20 ; CURACTPT - Current Active Patients
+21 ; ADJPANEL - Adjusted Panel Size
+22 ; AUTINACT - Inactivated Automatically
+23 ; FTEEHST - FTEE History
+24 ;
+25 NEW SCMCPATH,SCMCHFS,SCMCERR,SCMCMODE,MSG,IOF
+26 NEW SITE,SCDATA,SCIENS,STANUM,POSAHIEN,TPIEN,TMPOS,EFFDT,PRACTIEN,PRACTNR,STATUS,DATE,ENTRY,POP
+27 NEW STATRSN,FTEEEQU,DT4INACT,AVAILPOS,MAXPT,CURACTPT,ADJPANEL,AUTINACT,FTEEHST,FTEEDAT,FTEEVAL
+28 SET SITE=$$SITE^VASITE
SET STANUM=$PIECE(SITE,"^",3)
+29 SET SCMCPATH=$$DEFDIR^%ZISH()
SET SCMCHFS=STANUM_"_PCMMPOSITIONASSIGNMENTHISTORY.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 position assignment history file
+1 SET POSAHIEN=0
+2 FOR
SET POSAHIEN=$ORDER(^SCTM(404.52,POSAHIEN))
if POSAHIEN=""!(POSAHIEN'?.N)
QUIT
Begin DoDot:1
+3 KILL SCDATA
+4 SET SCIENS=+$GET(POSAHIEN)_","
+5 DO GETS^DIQ(404.52,SCIENS,".01;.02;.03;.04;.05;.07;.08;.09;.091;.096;.097;.098;.099;.11","IE","SCDATA","")
+6 SET TPIEN=$GET(SCDATA(404.52,SCIENS,.01,"I"))
+7 SET TMPOS=$GET(SCDATA(404.52,SCIENS,.01,"E"))
+8 SET EFFDT=$GET(SCDATA(404.52,SCIENS,.02,"E"))
+9 SET PRACTIEN=$GET(SCDATA(404.52,SCIENS,.03,"I"))
+10 SET PRACTNR=$GET(SCDATA(404.52,SCIENS,.03,"E"))
+11 SET STATUS=$GET(SCDATA(404.52,SCIENS,.04,"E"))
+12 SET STATRSN=$GET(SCDATA(404.52,SCIENS,.05,"E"))
+13 SET FTEEEQU=$GET(SCDATA(404.52,SCIENS,.09,"E"))
+14 SET DT4INACT=$GET(SCDATA(404.52,SCIENS,.091,"E"))
+15 SET AVAILPOS=$GET(SCDATA(404.52,SCIENS,.096,"E"))
+16 SET MAXPT=$GET(SCDATA(404.52,SCIENS,.097,"E"))
+17 SET CURACTPT=$GET(SCDATA(404.52,SCIENS,.098,"E"))
+18 SET ADJPANEL=$GET(SCDATA(404.52,SCIENS,.099,"E"))
+19 SET AUTINACT=$GET(SCDATA(404.52,SCIENS,.11,"I"))
+20 SET FTEEHST=$SELECT($DATA(^SCTM(404.52,POSAHIEN,1,0)):1,1:"")
IF FTEEHST
SET ENTRY=0
Begin DoDot:2
+21 FOR
SET ENTRY=$ORDER(^SCTM(404.52,POSAHIEN,1,ENTRY))
if ENTRY=""!(ENTRY'?.N)
QUIT
Begin DoDot:3
+22 SET FTEEDAT=$PIECE(^SCTM(404.52,POSAHIEN,1,ENTRY,0),"^")
SET DATE=$$FMTE^XLFDT(FTEEDAT,1)
+23 SET FTEEVAL=$PIECE(^SCTM(404.52,POSAHIEN,1,ENTRY,0),"^",2)
+24 SET WRTLN(ENTRY)="|"_DATE_"|"_FTEEVAL
+25 QUIT
End DoDot:3
End DoDot:2
+26 WRITE STANUM_"|"_POSAHIEN_"|"_TPIEN_"|"_TMPOS_"|"_EFFDT_"|"_PRACTIEN_"|"_PRACTNR_"|"_STATUS_"|"_STATRSN_"|"_FTEEEQU_"|"_DT4INACT_"|"_AVAILPOS_"|"_MAXPT_"|"_CURACTPT_"|"_ADJPANEL_"|"_AUTINACT
IF 'FTEEHST
WRITE !
+27 IF FTEEHST
FOR I=1:1
if '$DATA(WRTLN(I))
QUIT
Begin DoDot:2
+28 if I>1
WRITE STANUM_"|||||||||||||||"
WRITE WRTLN(I),!
End DoDot:2
+29 KILL FTEEHST,WRTLN,I
+30 QUIT
End DoDot:1
+31 QUIT
+32 ;
COLHDR ;Create column header for Position Assignment History extract file
+1 WRITE "Station #|Pos. Assign. History IEN|Team Position IEN|Team Position|Effective Date|Practitioner IEN|Practitioner|Status|Status Reason|FTEE Equivalent|Date Flagged for Inactivation|"
+2 WRITE "Available Positions|Max # of Patients|Current Active Patients|Adjusted Panel Size|Inactivated Automatically|FTEE Date|FTEE Value",!
+3 QUIT
+4 ;
END DO HFSCLOSE("SCMCRP",SCMCHFS)
+1 ;Create pipe delimited output if no errors
IF '+SCMCERR
Begin DoDot:1
+2 SET MSG=$NAME(^TMP("SCMC",$JOB))
End DoDot:1
QUIT
+3 ;Replace "##FFFF##" with Form Feeds - code needed for LINUX environments
+4 SET I=0
FOR
SET I=$ORDER(^TMP("SCMC",$JOB,1,I))
if 'I
QUIT
Begin DoDot:1
+5 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)
+6 SET ^TMP("SCMC",$JOB,1,I)=^TMP("SCMC",$JOB,1,I)_$CHAR(13)
+7 if ^TMP("SCMC",$JOB,1,I)["$END"
SET ^TMP("SCMC",$JOB,1,I)=""
End DoDot:1
+8 SET MSG=$NAME(^TMP("SCMC",$JOB))
+9 QUIT
+10 ;
HFSOPEN(HANDLE,SCMCPATH,SCMCHFS,SCMCMODE) ; Open File
+1 DO OPEN^%ZISH(HANDLE,SCMCPATH,SCMCHFS,$GET(SCMCMODE,"W"))
if POP
Begin DoDot:1
+2 SET SCMCERR=1
SET ^TMP("SCMC",$JOB,1)="0^Unable to open file "
End DoDot:1
if POP
QUIT
+3 ;resets screen position and adds page break flag - added to deal with Linux environments.
SET IOF="$$IOF^SCRPPAHS"
+4 QUIT
+5 ;
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 ;
