- SCRPTPOS ;ALB/DJS - Team Position Extract for PCMMR Data Validation; 04/08/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 #
- ; TPIEN - IEN of Team Position
- ; TPOS - Name of Team Position
- ; TIEN - IEN pointer to Team file #404.51
- ; TNAME - Team Name
- ; ROLEIEN - IEN of Standard Role
- ; ROLE - Standard Role Name
- ; POSSPP - Possible Primary Practitioner
- ; MAXPT - Max # of Patients
- ; PRECPOS - Preceptor Position
- ; ACTASPRE - Can act as a Preceptor?
- ; PDESC - Position Description
- ; DEATHMSG - Death Message
- ; INPTMSG - Inpatient Message
- ; TEAMMSG - Team Message
- ; PREDTHMS - Preceptor Death Message
- ; PREINPMS - Preceptor Inpatient Message
- ; PRETMMSG - Preceptor Team Message
- ; AUINAMSG - Automatic Inactivation Message
- ; PRAINMSG - Preceptor Automatic Inactivation Message
- ; CURPCPT - Current # of PC Patients
- ; CURPTS - Current # of Patients
- ; CURSTAT - Current Status == Active or Inactive
- ; CUREFFDT - Current Effective Date
- ; CURACTDT - Current Activation Date
- ; CURINADT - Current Inactivation Date
- ; CURPRAC - Current Practitioner
- ; CURPRCPS - Current Preceptor Position
- ; CURPREC - Current Preceptor
- ; ACTPREC - Active Precepts
- ;
- N SCMCPATH,SCMCHFS,SCMCERR,SCMCMODE,MSG,IOF
- N SITE,SCDATA,SCIENS,STANUM,TPIEN,TPOS,TIEN,TNAME,ROLEIEN,ROLE,POSSPP,MAXPT,PRECPOS,ACTASPRE,PDESC,DEATHMSG,INPTMSG,TEAMMSG,PREDTHMS
- N PREINPMS,PRETMMSG,AUINAMSG,PRAINMSG,CURPCPT,CURPTS,CURSTAT,CUREFFDT,CURACTDT,CURINADT,CURPRAC,CURPRCPS,CURPREC,ACTPREC
- S SITE=$$SITE^VASITE,STANUM=$P(SITE,"^",3)
- S SCMCPATH=$$DEFDIR^%ZISH(),SCMCHFS=STANUM_"_PCMMTEAMPOSITION.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 Team Position file and find all team positions
- S TPIEN=0
- F S TPIEN=$O(^SCTM(404.57,TPIEN)) Q:TPIEN=""!(TPIEN'?.N) D
- .K SCDATA
- .S SCIENS=+$G(TPIEN)_","
- .D GETS^DIQ(404.57,SCIENS,".01;.02;.03;.04;.08;.1;.12;1;2.01;2.02;2.03;2.05;2.06;2.07;2.09;2.10;200;201;300;301;302;303;304;305;306;307","IE","SCDATA","")
- .S TPOS=$G(SCDATA(404.57,SCIENS,.01,"E"))
- .S TIEN=$G(SCDATA(404.57,SCIENS,.02,"I"))
- .S TNAME=$G(SCDATA(404.57,SCIENS,.02,"E"))
- .S ROLEIEN=$G(SCDATA(404.57,SCIENS,.03,"I"))
- .S ROLE=$G(SCDATA(404.57,SCIENS,.03,"E"))
- .S POSSPP=$G(SCDATA(404.57,SCIENS,.04,"E"))
- .S MAXPT=$G(SCDATA(404.57,SCIENS,.08,"E"))
- .S PRECPOS=$G(SCDATA(404.57,SCIENS,.1,"E"))
- .S ACTASPRE=$G(SCDATA(404.57,SCIENS,.12,"E"))
- .S PDESC=$G(^SCTM(404.57,TPIEN,1,1,0))
- .S DEATHMSG=$G(SCDATA(404.57,SCIENS,2.01,"E"))
- .S INPTMSG=$G(SCDATA(404.57,SCIENS,2.02,"E"))
- .S TEAMMSG=$G(SCDATA(404.57,SCIENS,2.03,"E"))
- .S PREDTHMS=$G(SCDATA(404.57,SCIENS,2.05,"E"))
- .S PREINPMS=$G(SCDATA(404.57,SCIENS,2.06,"E"))
- .S PRETMMSG=$G(SCDATA(404.57,SCIENS,2.07,"E"))
- .S AUINAMSG=$G(SCDATA(404.57,SCIENS,2.09,"E"))
- .S PRAINMSG=$G(SCDATA(404.57,SCIENS,2.10,"E"))
- .S CURPCPT=$G(SCDATA(404.57,SCIENS,200,"E"))
- .S CURPTS=$G(SCDATA(404.57,SCIENS,201,"E"))
- .S CURSTAT=$G(SCDATA(404.57,SCIENS,300,"E"))
- .S CUREFFDT=$G(SCDATA(404.57,SCIENS,301,"E"))
- .S CURACTDT=$G(SCDATA(404.57,SCIENS,302,"E"))
- .S CURINADT=$G(SCDATA(404.57,SCIENS,303,"E"))
- .S CURPRAC=$G(SCDATA(404.57,SCIENS,304,"E"))
- .S CURPRCPS=$G(SCDATA(404.57,SCIENS,305,"E"))
- .S CURPREC=$G(SCDATA(404.57,SCIENS,306,"E"))
- .S ACTPREC=$G(SCDATA(404.57,SCIENS,307,"E"))
- .W STANUM_"|"_TPIEN_"|"_TPOS_"|"_TIEN_"|"_TNAME_"|"_ROLEIEN_"|"_ROLE_"|"_POSSPP_"|"_MAXPT_"|"_PRECPOS_"|"_ACTASPRE_"|"_PDESC_"|"_DEATHMSG_"|"_INPTMSG_"|"_TEAMMSG_"|"_PREDTHMS_"|"
- .W PREINPMS_"|"_PRETMMSG_"|"_AUINAMSG_"|"_PRAINMSG_"|"_CURPCPT_"|"_CURPTS_"|"_CURSTAT_"|"_CUREFFDT_"|"_CURACTDT_"|"_CURINADT_"|"_CURPRAC_"|"_CURPRCPS_"|"_CURPREC_"|"_ACTPREC,!
- Q
- ;
- COLHDR ;Create column header for Team Position extract file
- W "Station #|Position IEN|Position Name|Team IEN|Team Name|Standard Role IEN|Standard Role Name|Possible Primary Practitioner|Max # Patients|Preceptor Position|Can Act as Preceptor|Position Description|"
- W "Death Message|Inpatient Message|Team Message|Preceptor Death Message|Preceptor Inpatient Message|Preceptor Team Message|Auto Inactivation Message|Prec Auto Inactivation Message|Current # PC Patients|"
- W "Current # Patients|Current Status|Current Effective Date|Current Activation Date|Current Inactivation Date|Current Practitioner|Current Preceptor Position|Current Preceptor|Active Precepts",!
- 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^SCRPTPOS" ;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[HSCRPTPOS 5728 printed Jan 18, 2025@03:44:15 Page 2
- SCRPTPOS ;ALB/DJS - Team Position Extract for PCMMR Data Validation; 04/08/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 ; TPIEN - IEN of Team Position
- +9 ; TPOS - Name of Team Position
- +10 ; TIEN - IEN pointer to Team file #404.51
- +11 ; TNAME - Team Name
- +12 ; ROLEIEN - IEN of Standard Role
- +13 ; ROLE - Standard Role Name
- +14 ; POSSPP - Possible Primary Practitioner
- +15 ; MAXPT - Max # of Patients
- +16 ; PRECPOS - Preceptor Position
- +17 ; ACTASPRE - Can act as a Preceptor?
- +18 ; PDESC - Position Description
- +19 ; DEATHMSG - Death Message
- +20 ; INPTMSG - Inpatient Message
- +21 ; TEAMMSG - Team Message
- +22 ; PREDTHMS - Preceptor Death Message
- +23 ; PREINPMS - Preceptor Inpatient Message
- +24 ; PRETMMSG - Preceptor Team Message
- +25 ; AUINAMSG - Automatic Inactivation Message
- +26 ; PRAINMSG - Preceptor Automatic Inactivation Message
- +27 ; CURPCPT - Current # of PC Patients
- +28 ; CURPTS - Current # of Patients
- +29 ; CURSTAT - Current Status == Active or Inactive
- +30 ; CUREFFDT - Current Effective Date
- +31 ; CURACTDT - Current Activation Date
- +32 ; CURINADT - Current Inactivation Date
- +33 ; CURPRAC - Current Practitioner
- +34 ; CURPRCPS - Current Preceptor Position
- +35 ; CURPREC - Current Preceptor
- +36 ; ACTPREC - Active Precepts
- +37 ;
- +38 NEW SCMCPATH,SCMCHFS,SCMCERR,SCMCMODE,MSG,IOF
- +39 NEW SITE,SCDATA,SCIENS,STANUM,TPIEN,TPOS,TIEN,TNAME,ROLEIEN,ROLE,POSSPP,MAXPT,PRECPOS,ACTASPRE,PDESC,DEATHMSG,INPTMSG,TEAMMSG,PREDTHMS
- +40 NEW PREINPMS,PRETMMSG,AUINAMSG,PRAINMSG,CURPCPT,CURPTS,CURSTAT,CUREFFDT,CURACTDT,CURINADT,CURPRAC,CURPRCPS,CURPREC,ACTPREC
- +41 SET SITE=$$SITE^VASITE
- SET STANUM=$PIECE(SITE,"^",3)
- +42 SET SCMCPATH=$$DEFDIR^%ZISH()
- SET SCMCHFS=STANUM_"_PCMMTEAMPOSITION.TXT"
- SET SCMCERR=0
- USE 0
- WRITE !!,SCMCPATH
- +43 DO HFSOPEN("SCMCRP",SCMCPATH,SCMCHFS,"W")
- IF SCMCERR
- GOTO END
- +44 USE IO
- +45 DO COLHDR
- DO SETREC
- GOTO END
- +46 ;
- SETREC ;$O through Team Position file and find all team positions
- +1 SET TPIEN=0
- +2 FOR
- SET TPIEN=$ORDER(^SCTM(404.57,TPIEN))
- if TPIEN=""!(TPIEN'?.N)
- QUIT
- Begin DoDot:1
- +3 KILL SCDATA
- +4 SET SCIENS=+$GET(TPIEN)_","
- +5 DO GETS^DIQ(404.57,SCIENS,".01;.02;.03;.04;.08;.1;.12;1;2.01;2.02;2.03;2.05;2.06;2.07;2.09;2.10;200;201;300;301;302;303;304;305;306;307","IE","SCDATA","")
- +6 SET TPOS=$GET(SCDATA(404.57,SCIENS,.01,"E"))
- +7 SET TIEN=$GET(SCDATA(404.57,SCIENS,.02,"I"))
- +8 SET TNAME=$GET(SCDATA(404.57,SCIENS,.02,"E"))
- +9 SET ROLEIEN=$GET(SCDATA(404.57,SCIENS,.03,"I"))
- +10 SET ROLE=$GET(SCDATA(404.57,SCIENS,.03,"E"))
- +11 SET POSSPP=$GET(SCDATA(404.57,SCIENS,.04,"E"))
- +12 SET MAXPT=$GET(SCDATA(404.57,SCIENS,.08,"E"))
- +13 SET PRECPOS=$GET(SCDATA(404.57,SCIENS,.1,"E"))
- +14 SET ACTASPRE=$GET(SCDATA(404.57,SCIENS,.12,"E"))
- +15 SET PDESC=$GET(^SCTM(404.57,TPIEN,1,1,0))
- +16 SET DEATHMSG=$GET(SCDATA(404.57,SCIENS,2.01,"E"))
- +17 SET INPTMSG=$GET(SCDATA(404.57,SCIENS,2.02,"E"))
- +18 SET TEAMMSG=$GET(SCDATA(404.57,SCIENS,2.03,"E"))
- +19 SET PREDTHMS=$GET(SCDATA(404.57,SCIENS,2.05,"E"))
- +20 SET PREINPMS=$GET(SCDATA(404.57,SCIENS,2.06,"E"))
- +21 SET PRETMMSG=$GET(SCDATA(404.57,SCIENS,2.07,"E"))
- +22 SET AUINAMSG=$GET(SCDATA(404.57,SCIENS,2.09,"E"))
- +23 SET PRAINMSG=$GET(SCDATA(404.57,SCIENS,2.10,"E"))
- +24 SET CURPCPT=$GET(SCDATA(404.57,SCIENS,200,"E"))
- +25 SET CURPTS=$GET(SCDATA(404.57,SCIENS,201,"E"))
- +26 SET CURSTAT=$GET(SCDATA(404.57,SCIENS,300,"E"))
- +27 SET CUREFFDT=$GET(SCDATA(404.57,SCIENS,301,"E"))
- +28 SET CURACTDT=$GET(SCDATA(404.57,SCIENS,302,"E"))
- +29 SET CURINADT=$GET(SCDATA(404.57,SCIENS,303,"E"))
- +30 SET CURPRAC=$GET(SCDATA(404.57,SCIENS,304,"E"))
- +31 SET CURPRCPS=$GET(SCDATA(404.57,SCIENS,305,"E"))
- +32 SET CURPREC=$GET(SCDATA(404.57,SCIENS,306,"E"))
- +33 SET ACTPREC=$GET(SCDATA(404.57,SCIENS,307,"E"))
- +34 WRITE STANUM_"|"_TPIEN_"|"_TPOS_"|"_TIEN_"|"_TNAME_"|"_ROLEIEN_"|"_ROLE_"|"_POSSPP_"|"_MAXPT_"|"_PRECPOS_"|"_ACTASPRE_"|"_PDESC_"|"_DEATHMSG_"|"_INPTMSG_"|"_TEAMMSG_"|"_PREDTHMS_"|"
- +35 WRITE PREINPMS_"|"_PRETMMSG_"|"_AUINAMSG_"|"_PRAINMSG_"|"_CURPCPT_"|"_CURPTS_"|"_CURSTAT_"|"_CUREFFDT_"|"_CURACTDT_"|"_CURINADT_"|"_CURPRAC_"|"_CURPRCPS_"|"_CURPREC_"|"_ACTPREC,!
- End DoDot:1
- +36 QUIT
- +37 ;
- COLHDR ;Create column header for Team Position extract file
- +1 WRITE "Station #|Position IEN|Position Name|Team IEN|Team Name|Standard Role IEN|Standard Role Name|Possible Primary Practitioner|Max # Patients|Preceptor Position|Can Act as Preceptor|Position Description|"
- +2 WRITE "Death Message|Inpatient Message|Team Message|Preceptor Death Message|Preceptor Inpatient Message|Preceptor Team Message|Auto Inactivation Message|Prec Auto Inactivation Message|Current # PC Patients|"
- +3 WRITE "Current # Patients|Current Status|Current Effective Date|Current Activation Date|Current Inactivation Date|Current Practitioner|Current Preceptor Position|Current Preceptor|Active Precepts",!
- +4 QUIT
- +5 ;
- 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^SCRPTPOS"
- +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 ;