PXRRWLSE ;ISL/PKR,ISA/Zoltan - Sort encounters for encounter summary report. ;12/1/1998
;;1.0;PCE PATIENT CARE ENCOUNTER;**20,58,61**;Aug 12, 1996
;
;Sort the encounters according to the selection criteria.
SORT ;
N BYCLOC,BD,BUSY,CLINIC,CLINIEN,CPT,CSSCR
N DATE,DAY,DFN,ED,EM,EMLIST,FAC,FACILITY,FOUND
N HLOCIEN,HLOCNAM,HSSCR,IC,INOUT,LOCATION,NEWPIEN
N PCLASS,PPNAME
N PROVIDER,PRVCNT,PRVIEN,PRVSCR
N STOIND,TEMP,TOTUNIQ,TOTVIS,UPAT,VIEN,VISIT,VISIT150,VISITS
N MULTPR
;
D SORT2^PXRRWLS2
;
S BD=PXRRBDT-.0001
S ED=PXRREDT+.2359
NDATE S BD=$O(^AUPNVSIT("B",BD))
;If we have passed the ending date we are done.
I (BD>ED)!(BD="") G DONE
;
;If this is an interactive session let the user know that something
;is happening.
I '(PXRRQUE!$D(IO("S"))) D SPIN^PXRRBUSY("Sorting encounters",.BUSY)
;
;Check for a user request to stop the task.
I $$S^%ZTLOAD S ZTSTOP=1 D EXIT^PXRRGUT
;
;Get the VISIT IEN
S VIEN=0
VISIT S VIEN=$O(^AUPNVSIT("B",BD,VIEN))
I VIEN="" G NDATE
S VISIT=^AUPNVSIT(VIEN,0)
;
;Screen out inappropriate vists.
;Service categories.
I PXRRSCAT'[$P(VISIT,U,7) G VISIT
;Encounter types.
S VISIT150=$G(^AUPNVSIT(VIEN,150))
I PXRRENTY'[$P(VISIT150,U,3) G VISIT
;
;Make sure that the facility is on the list.
S FOUND=0
S FAC=$P(VISIT,U,6)
F IC=1:1:NFAC I $P(PXRRFAC(IC),U,1)=FAC D Q
. S FACILITY=FAC
. S FOUND=1
I 'FOUND G VISIT
;
S HLOCNAM=""
;
D VISIT2^PXRRWLS2
;
I 'FOUND G VISIT
;
;Get the Provider
S PRVCNT=0
S PRVIEN=0
S MULTPR=""
PRV ;
S PRVIEN=$O(^AUPNVPRV("AD",VIEN,PRVIEN))
I (PRVIEN="")&(PRVCNT>0) G VISIT
I (PRVIEN="") S NEWPIEN=0
E S NEWPIEN=+$P(^AUPNVPRV(PRVIEN,0),U,1)
S PRVCNT=PRVCNT+1
I NEWPIEN>0 S PPNAME=$P(^VA(200,NEWPIEN,0),U,1)_U_NEWPIEN
E S PPNAME="Unknown"_U_NEWPIEN
;
;Apply any Provider screens.
;List of providers.
I $D(PXRRPRPL) D G:'FOUND PRV
. S FOUND=0
. F IC=1:1:NPL I $P(PXRRPRPL(IC),U,2)=NEWPIEN D Q
..;Mark this provider as being matched.
.. S $P(PXRRPRPL(IC),U,4)="M"
.. S FOUND=1
;
;Person class screen.
I $D(PXRRPECL) D G:'FOUND PRV
. S PCLASS=$$OCCUP^PXBGPRV(NEWPIEN,BD,"",1,"")
. S FOUND=$$MATCH^PXRRPECU(PCLASS)
. S PPNAME=PPNAME_U_$P(PCLASS,U,7)
;
D PRV2^PXRRWLS2
;
CLOC ;
D CLOC2^PXRRWLS2
;
;Find the CPT code(s) and associated E&M codes for this encounter.
S IC=$O(^AUPNVCPT("AD",VIEN,""))
I +IC=0 D G BYCLOC
. S ^XTMP(PXRRXTMP,FACILITY,STOIND,"NOCPT")=$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"NOCPT"))+1
.;Total for multiple provider encounters.
. I MULTPR S ^XTMP(PXRRXTMP,FACILITY,"&&","NOCPT")=$G(^XTMP(PXRRXTMP,FACILITY,"&&","NOCPT"))+1
;
S IC=""
GETCPT S IC=$O(^AUPNVCPT("AD",VIEN,IC))
I +IC>0 D GC2^PXRRWLS2 G GETCPT
;
BYCLOC ;If necessary accumulate the information about each clinic stop
;location.
I BYCLOC,$L(STOIND,U)=3 D G CLOC
. S HLOCIEN=$P(VISIT,U,22)
. ;Null Subscript: Visit is missing hospital location.
. ;Undefined: Hospital Location may have been deleted.
. S STOIND=STOIND_U_$P(^SC(HLOCIEN,0),U,1)
;Pass flag to report for header message.
I MULTPR=1 S ^XTMP(PXRRXTMP,"PXRRMPR")=1
; Get the next provider for the encounter...
S PXRRPRSC=$G(PXRRPRSC) ; Ensure it exists.
I $E(PXRRPRSC)="S",$G(NPL)>1 S MULTPR=1 G PRV
I $E(PXRRPRSC)="C"!($E(PXRRPRSC)="A") S MULTPR=1 G PRV
; ...or get the next encounter.
G VISIT
;
DONE ;
;Process the patient list, get the number of unique patients, and the
;number of visits. A visit is defined to be any activity for a patient
;within a 24 hour period.
;
S FACILITY=0
NFAC S FACILITY=$O(^TMP(PXRRXTMP,$J,FACILITY))
I +FACILITY=0 G SDONE
;
D NF2^PXRRWLS2
;
S STOIND="&"
NSTO S STOIND=$O(^TMP(PXRRXTMP,$J,FACILITY,STOIND))
I STOIND="" G NFAC
;
S TOTVIS=0
S UPAT=0
S VISITS(0)=0
S VISITS(1)=0
;
;If this is an interactive session let the user know that something
;is happening.
I '(PXRRQUE!$D(IO("S"))) D SPIN^PXRRBUSY("Sorting encounters",.BUSY)
;
S DFN=0
NDFN S DFN=$O(^TMP(PXRRXTMP,$J,FACILITY,STOIND,"PATIENT",DFN))
I +DFN=0 D G NSTO
. S ^XTMP(PXRRXTMP,FACILITY,STOIND,"TOTVIS")=TOTVIS
. S ^XTMP(PXRRXTMP,FACILITY,STOIND,"UPAT")=UPAT
. S ^XTMP(PXRRXTMP,FACILITY,STOIND,"VISITS",0)=VISITS(0)
. S ^XTMP(PXRRXTMP,FACILITY,STOIND,"VISITS",1)=VISITS(1)
S UPAT=UPAT+1
;
S DAY=""
NDAY S DAY=$O(^TMP(PXRRXTMP,$J,FACILITY,STOIND,"PATIENT",DFN,DAY))
I DAY="" G NDFN
S TOTVIS=TOTVIS+1
;
S INOUT=-1
NINOUT S INOUT=$O(^TMP(PXRRXTMP,$J,FACILITY,STOIND,"PATIENT",DFN,DAY,INOUT))
I INOUT="" G NDAY
S VISITS(INOUT)=VISITS(INOUT)+1
G NINOUT
;
SDONE ;Sorting is done.
I '(PXRRQUE!$D(IO("S"))) D DONE^PXRRBUSY("done")
K ^TMP(PXRRXTMP)
;
;If there were selected clinic stops build dummy entries for all
;those without entries.
I $D(PXRRCS) D
. F FAC=1:1:NFAC D
.. S FACILITY=$P(PXRRFAC(FAC),U,1)
.. F IC=1:1:NCS D
... I $P(PXRRCS(IC),U,4)'="M" D
.... S HLOCNAM=PXRRCS(IC)
.... S ^XTMP(PXRRXTMP,FACILITY,HLOCNAM,0,0)=""
;
;If there were selected hospital locations build dummy entries for all
;those without entries.
I $D(PXRRLCHL) D
. F FAC=1:1:NFAC D
.. S FACILITY=$P(PXRRFAC(FAC),U,1)
.. F IC=1:1:NHL D
... I $P(PXRRLCHL(IC),U,4)'="M" D
.... S HLOCNAM=PXRRLCHL(IC)
.... S ^XTMP(PXRRXTMP,FACILITY,HLOCNAM,0,0)=""
;
EXIT ;
;Sort the appointment information.
I PXRRQUE D
.;Start the appointment sorting that was queued but not scheduled.
. N DESC,ROUTINE,TASK
. S ROUTINE="PXRRWLSA"
. S DESC="Encounter Summary Report - sort appointments"
. S ZTDTH=$$NOW^XLFDT
. S TASK=^XTMP(PXRRXTMP,"SAZTSK")
. D REQUE^PXRRQUE(DESC,ROUTINE,TASK)
E D SORT^PXRRWLSA
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRRWLSE 5721 printed Apr 09, 2024@21:30:45 Page 2
PXRRWLSE ;ISL/PKR,ISA/Zoltan - Sort encounters for encounter summary report. ;12/1/1998
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**20,58,61**;Aug 12, 1996
+2 ;
+3 ;Sort the encounters according to the selection criteria.
SORT ;
+1 NEW BYCLOC,BD,BUSY,CLINIC,CLINIEN,CPT,CSSCR
+2 NEW DATE,DAY,DFN,ED,EM,EMLIST,FAC,FACILITY,FOUND
+3 NEW HLOCIEN,HLOCNAM,HSSCR,IC,INOUT,LOCATION,NEWPIEN
+4 NEW PCLASS,PPNAME
+5 NEW PROVIDER,PRVCNT,PRVIEN,PRVSCR
+6 NEW STOIND,TEMP,TOTUNIQ,TOTVIS,UPAT,VIEN,VISIT,VISIT150,VISITS
+7 NEW MULTPR
+8 ;
+9 DO SORT2^PXRRWLS2
+10 ;
+11 SET BD=PXRRBDT-.0001
+12 SET ED=PXRREDT+.2359
NDATE SET BD=$ORDER(^AUPNVSIT("B",BD))
+1 ;If we have passed the ending date we are done.
+2 IF (BD>ED)!(BD="")
GOTO DONE
+3 ;
+4 ;If this is an interactive session let the user know that something
+5 ;is happening.
+6 IF '(PXRRQUE!$DATA(IO("S")))
DO SPIN^PXRRBUSY("Sorting encounters",.BUSY)
+7 ;
+8 ;Check for a user request to stop the task.
+9 IF $$S^%ZTLOAD
SET ZTSTOP=1
DO EXIT^PXRRGUT
+10 ;
+11 ;Get the VISIT IEN
+12 SET VIEN=0
VISIT SET VIEN=$ORDER(^AUPNVSIT("B",BD,VIEN))
+1 IF VIEN=""
GOTO NDATE
+2 SET VISIT=^AUPNVSIT(VIEN,0)
+3 ;
+4 ;Screen out inappropriate vists.
+5 ;Service categories.
+6 IF PXRRSCAT'[$PIECE(VISIT,U,7)
GOTO VISIT
+7 ;Encounter types.
+8 SET VISIT150=$GET(^AUPNVSIT(VIEN,150))
+9 IF PXRRENTY'[$PIECE(VISIT150,U,3)
GOTO VISIT
+10 ;
+11 ;Make sure that the facility is on the list.
+12 SET FOUND=0
+13 SET FAC=$PIECE(VISIT,U,6)
+14 FOR IC=1:1:NFAC
IF $PIECE(PXRRFAC(IC),U,1)=FAC
Begin DoDot:1
+15 SET FACILITY=FAC
+16 SET FOUND=1
End DoDot:1
QUIT
+17 IF 'FOUND
GOTO VISIT
+18 ;
+19 SET HLOCNAM=""
+20 ;
+21 DO VISIT2^PXRRWLS2
+22 ;
+23 IF 'FOUND
GOTO VISIT
+24 ;
+25 ;Get the Provider
+26 SET PRVCNT=0
+27 SET PRVIEN=0
+28 SET MULTPR=""
PRV ;
+1 SET PRVIEN=$ORDER(^AUPNVPRV("AD",VIEN,PRVIEN))
+2 IF (PRVIEN="")&(PRVCNT>0)
GOTO VISIT
+3 IF (PRVIEN="")
SET NEWPIEN=0
+4 IF '$TEST
SET NEWPIEN=+$PIECE(^AUPNVPRV(PRVIEN,0),U,1)
+5 SET PRVCNT=PRVCNT+1
+6 IF NEWPIEN>0
SET PPNAME=$PIECE(^VA(200,NEWPIEN,0),U,1)_U_NEWPIEN
+7 IF '$TEST
SET PPNAME="Unknown"_U_NEWPIEN
+8 ;
+9 ;Apply any Provider screens.
+10 ;List of providers.
+11 IF $DATA(PXRRPRPL)
Begin DoDot:1
+12 SET FOUND=0
+13 FOR IC=1:1:NPL
IF $PIECE(PXRRPRPL(IC),U,2)=NEWPIEN
Begin DoDot:2
+14 ;Mark this provider as being matched.
+15 SET $PIECE(PXRRPRPL(IC),U,4)="M"
+16 SET FOUND=1
End DoDot:2
QUIT
End DoDot:1
if 'FOUND
GOTO PRV
+17 ;
+18 ;Person class screen.
+19 IF $DATA(PXRRPECL)
Begin DoDot:1
+20 SET PCLASS=$$OCCUP^PXBGPRV(NEWPIEN,BD,"",1,"")
+21 SET FOUND=$$MATCH^PXRRPECU(PCLASS)
+22 SET PPNAME=PPNAME_U_$PIECE(PCLASS,U,7)
End DoDot:1
if 'FOUND
GOTO PRV
+23 ;
+24 DO PRV2^PXRRWLS2
+25 ;
CLOC ;
+1 DO CLOC2^PXRRWLS2
+2 ;
+3 ;Find the CPT code(s) and associated E&M codes for this encounter.
+4 SET IC=$ORDER(^AUPNVCPT("AD",VIEN,""))
+5 IF +IC=0
Begin DoDot:1
+6 SET ^XTMP(PXRRXTMP,FACILITY,STOIND,"NOCPT")=$GET(^XTMP(PXRRXTMP,FACILITY,STOIND,"NOCPT"))+1
+7 ;Total for multiple provider encounters.
+8 IF MULTPR
SET ^XTMP(PXRRXTMP,FACILITY,"&&","NOCPT")=$GET(^XTMP(PXRRXTMP,FACILITY,"&&","NOCPT"))+1
End DoDot:1
GOTO BYCLOC
+9 ;
+10 SET IC=""
GETCPT SET IC=$ORDER(^AUPNVCPT("AD",VIEN,IC))
+1 IF +IC>0
DO GC2^PXRRWLS2
GOTO GETCPT
+2 ;
BYCLOC ;If necessary accumulate the information about each clinic stop
+1 ;location.
+2 IF BYCLOC
IF $LENGTH(STOIND,U)=3
Begin DoDot:1
+3 SET HLOCIEN=$PIECE(VISIT,U,22)
+4 ;Null Subscript: Visit is missing hospital location.
+5 ;Undefined: Hospital Location may have been deleted.
+6 SET STOIND=STOIND_U_$PIECE(^SC(HLOCIEN,0),U,1)
End DoDot:1
GOTO CLOC
+7 ;Pass flag to report for header message.
+8 IF MULTPR=1
SET ^XTMP(PXRRXTMP,"PXRRMPR")=1
+9 ; Get the next provider for the encounter...
+10 ; Ensure it exists.
SET PXRRPRSC=$GET(PXRRPRSC)
+11 IF $EXTRACT(PXRRPRSC)="S"
IF $GET(NPL)>1
SET MULTPR=1
GOTO PRV
+12 IF $EXTRACT(PXRRPRSC)="C"!($EXTRACT(PXRRPRSC)="A")
SET MULTPR=1
GOTO PRV
+13 ; ...or get the next encounter.
+14 GOTO VISIT
+15 ;
DONE ;
+1 ;Process the patient list, get the number of unique patients, and the
+2 ;number of visits. A visit is defined to be any activity for a patient
+3 ;within a 24 hour period.
+4 ;
+5 SET FACILITY=0
NFAC SET FACILITY=$ORDER(^TMP(PXRRXTMP,$JOB,FACILITY))
+1 IF +FACILITY=0
GOTO SDONE
+2 ;
+3 DO NF2^PXRRWLS2
+4 ;
+5 SET STOIND="&"
NSTO SET STOIND=$ORDER(^TMP(PXRRXTMP,$JOB,FACILITY,STOIND))
+1 IF STOIND=""
GOTO NFAC
+2 ;
+3 SET TOTVIS=0
+4 SET UPAT=0
+5 SET VISITS(0)=0
+6 SET VISITS(1)=0
+7 ;
+8 ;If this is an interactive session let the user know that something
+9 ;is happening.
+10 IF '(PXRRQUE!$DATA(IO("S")))
DO SPIN^PXRRBUSY("Sorting encounters",.BUSY)
+11 ;
+12 SET DFN=0
NDFN SET DFN=$ORDER(^TMP(PXRRXTMP,$JOB,FACILITY,STOIND,"PATIENT",DFN))
+1 IF +DFN=0
Begin DoDot:1
+2 SET ^XTMP(PXRRXTMP,FACILITY,STOIND,"TOTVIS")=TOTVIS
+3 SET ^XTMP(PXRRXTMP,FACILITY,STOIND,"UPAT")=UPAT
+4 SET ^XTMP(PXRRXTMP,FACILITY,STOIND,"VISITS",0)=VISITS(0)
+5 SET ^XTMP(PXRRXTMP,FACILITY,STOIND,"VISITS",1)=VISITS(1)
End DoDot:1
GOTO NSTO
+6 SET UPAT=UPAT+1
+7 ;
+8 SET DAY=""
NDAY SET DAY=$ORDER(^TMP(PXRRXTMP,$JOB,FACILITY,STOIND,"PATIENT",DFN,DAY))
+1 IF DAY=""
GOTO NDFN
+2 SET TOTVIS=TOTVIS+1
+3 ;
+4 SET INOUT=-1
NINOUT SET INOUT=$ORDER(^TMP(PXRRXTMP,$JOB,FACILITY,STOIND,"PATIENT",DFN,DAY,INOUT))
+1 IF INOUT=""
GOTO NDAY
+2 SET VISITS(INOUT)=VISITS(INOUT)+1
+3 GOTO NINOUT
+4 ;
SDONE ;Sorting is done.
+1 IF '(PXRRQUE!$DATA(IO("S")))
DO DONE^PXRRBUSY("done")
+2 KILL ^TMP(PXRRXTMP)
+3 ;
+4 ;If there were selected clinic stops build dummy entries for all
+5 ;those without entries.
+6 IF $DATA(PXRRCS)
Begin DoDot:1
+7 FOR FAC=1:1:NFAC
Begin DoDot:2
+8 SET FACILITY=$PIECE(PXRRFAC(FAC),U,1)
+9 FOR IC=1:1:NCS
Begin DoDot:3
+10 IF $PIECE(PXRRCS(IC),U,4)'="M"
Begin DoDot:4
+11 SET HLOCNAM=PXRRCS(IC)
+12 SET ^XTMP(PXRRXTMP,FACILITY,HLOCNAM,0,0)=""
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+13 ;
+14 ;If there were selected hospital locations build dummy entries for all
+15 ;those without entries.
+16 IF $DATA(PXRRLCHL)
Begin DoDot:1
+17 FOR FAC=1:1:NFAC
Begin DoDot:2
+18 SET FACILITY=$PIECE(PXRRFAC(FAC),U,1)
+19 FOR IC=1:1:NHL
Begin DoDot:3
+20 IF $PIECE(PXRRLCHL(IC),U,4)'="M"
Begin DoDot:4
+21 SET HLOCNAM=PXRRLCHL(IC)
+22 SET ^XTMP(PXRRXTMP,FACILITY,HLOCNAM,0,0)=""
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+23 ;
EXIT ;
+1 ;Sort the appointment information.
+2 IF PXRRQUE
Begin DoDot:1
+3 ;Start the appointment sorting that was queued but not scheduled.
+4 NEW DESC,ROUTINE,TASK
+5 SET ROUTINE="PXRRWLSA"
+6 SET DESC="Encounter Summary Report - sort appointments"
+7 SET ZTDTH=$$NOW^XLFDT
+8 SET TASK=^XTMP(PXRRXTMP,"SAZTSK")
+9 DO REQUE^PXRRQUE(DESC,ROUTINE,TASK)
End DoDot:1
+10 IF '$TEST
DO SORT^PXRRWLSA
+11 QUIT
