PXRRWLSA ;ISL/PKR - Sort appointments for encounter summary report. ;12/1/98
;;1.0;PCE PATIENT CARE ENCOUNTER;**20,61**;Aug 12, 1996
;
;Sort the encounters found in PXRRWLSE and attach them to appointments.
SORT ;
N APPT,BUSY,DATE,DFN,FACILITY,IC,OUPENC,POV,STOIND,VIEN
N MULTPR
;
;Allow the task to be cleaned up upon successful completion.
S ZTREQ="@"
;
I '(PXRRQUE!$D(IO("S"))) D INIT^PXRRBUSY(.BUSY)
;
S FACILITY=0
NFAC S FACILITY=$O(^XTMP(PXRRXTMP,FACILITY))
I +FACILITY=0 G DONE
;
S STOIND=""
NIND S STOIND=$O(^XTMP(PXRRXTMP,FACILITY,STOIND))
I STOIND="" G NFAC
;
S DFN=0
NDFN S DFN=$O(^XTMP(PXRRXTMP,FACILITY,STOIND,"PATIENT",DFN))
I +DFN=0 G NIND
;
S DATE=0
NDATE S DATE=$O(^XTMP(PXRRXTMP,FACILITY,STOIND,"PATIENT",DFN,DATE))
I +DATE=0 G NDFN
;
;If this is an interactive session let the user know that something
;is happening.
I '(PXRRQUE!$D(IO("S"))) D SPIN^PXRRBUSY("Sorting appointments",.BUSY)
;
;Check for a user request to stop the task.
I $$S^%ZTLOAD S ZTSTOP=1 D EXIT^PXRRGUT
;
S VIEN=0
NVISIT S VIEN=$O(^XTMP(PXRRXTMP,FACILITY,STOIND,"PATIENT",DFN,DATE,VIEN))
I +VIEN=0 G NDATE
;
S MULTPR=$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"PATIENT",DFN,DATE,VIEN))
;
;We have a DFN, DATE, and a VIEN look for an appointment.
;We will need DBIAs for reading DPT and SCE.
S APPT=$G(^DPT(DFN,"S",DATE,0))
S OUPENC=$P(APPT,U,20)
I $L(OUPENC)>0 D
.;Make sure that we point back to the same visit.
. I $P($G(^SCE(OUPENC,0)),U,5)=VIEN D
..;Save the purpose of visit.
.. S POV=$P(APPT,U,7)
.. S ^XTMP(PXRRXTMP,FACILITY,STOIND,"POV",POV)=$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"POV",POV))+1
.. I MULTPR=1 D
... S ^XTMP(PXRRXTMP,FACILITY,"&&","POV",POV)=$G(^XTMP(PXRRXTMP,FACILITY,"&&","POV",POV))+1
G NVISIT
;
DONE ;
;Sorting is done.
I '(PXRRQUE!$D(IO("S"))) D DONE^PXRRBUSY("done")
EXIT ;
;
;Print the report information.
I PXRRQUE D
.;Start the printing that was queued but not scheduled.
. N DESC,ROUTINE,TASK
. S ROUTINE="PXRRWLPR"
. S DESC="Encounter Summary Report - print"
. S ZTDTH=$$NOW^XLFDT
. S TASK=^XTMP(PXRRXTMP,"PRZTSK")
. D REQUE^PXRRQUE(DESC,ROUTINE,TASK)
E D ^PXRRWLPR
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRRWLSA 2219 printed Apr 09, 2024@21:32:49 Page 2
PXRRWLSA ;ISL/PKR - Sort appointments for encounter summary report. ;12/1/98
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**20,61**;Aug 12, 1996
+2 ;
+3 ;Sort the encounters found in PXRRWLSE and attach them to appointments.
SORT ;
+1 NEW APPT,BUSY,DATE,DFN,FACILITY,IC,OUPENC,POV,STOIND,VIEN
+2 NEW MULTPR
+3 ;
+4 ;Allow the task to be cleaned up upon successful completion.
+5 SET ZTREQ="@"
+6 ;
+7 IF '(PXRRQUE!$DATA(IO("S")))
DO INIT^PXRRBUSY(.BUSY)
+8 ;
+9 SET FACILITY=0
NFAC SET FACILITY=$ORDER(^XTMP(PXRRXTMP,FACILITY))
+1 IF +FACILITY=0
GOTO DONE
+2 ;
+3 SET STOIND=""
NIND SET STOIND=$ORDER(^XTMP(PXRRXTMP,FACILITY,STOIND))
+1 IF STOIND=""
GOTO NFAC
+2 ;
+3 SET DFN=0
NDFN SET DFN=$ORDER(^XTMP(PXRRXTMP,FACILITY,STOIND,"PATIENT",DFN))
+1 IF +DFN=0
GOTO NIND
+2 ;
+3 SET DATE=0
NDATE SET DATE=$ORDER(^XTMP(PXRRXTMP,FACILITY,STOIND,"PATIENT",DFN,DATE))
+1 IF +DATE=0
GOTO NDFN
+2 ;
+3 ;If this is an interactive session let the user know that something
+4 ;is happening.
+5 IF '(PXRRQUE!$DATA(IO("S")))
DO SPIN^PXRRBUSY("Sorting appointments",.BUSY)
+6 ;
+7 ;Check for a user request to stop the task.
+8 IF $$S^%ZTLOAD
SET ZTSTOP=1
DO EXIT^PXRRGUT
+9 ;
+10 SET VIEN=0
NVISIT SET VIEN=$ORDER(^XTMP(PXRRXTMP,FACILITY,STOIND,"PATIENT",DFN,DATE,VIEN))
+1 IF +VIEN=0
GOTO NDATE
+2 ;
+3 SET MULTPR=$GET(^XTMP(PXRRXTMP,FACILITY,STOIND,"PATIENT",DFN,DATE,VIEN))
+4 ;
+5 ;We have a DFN, DATE, and a VIEN look for an appointment.
+6 ;We will need DBIAs for reading DPT and SCE.
+7 SET APPT=$GET(^DPT(DFN,"S",DATE,0))
+8 SET OUPENC=$PIECE(APPT,U,20)
+9 IF $LENGTH(OUPENC)>0
Begin DoDot:1
+10 ;Make sure that we point back to the same visit.
+11 IF $PIECE($GET(^SCE(OUPENC,0)),U,5)=VIEN
Begin DoDot:2
+12 ;Save the purpose of visit.
+13 SET POV=$PIECE(APPT,U,7)
+14 SET ^XTMP(PXRRXTMP,FACILITY,STOIND,"POV",POV)=$GET(^XTMP(PXRRXTMP,FACILITY,STOIND,"POV",POV))+1
+15 IF MULTPR=1
Begin DoDot:3
+16 SET ^XTMP(PXRRXTMP,FACILITY,"&&","POV",POV)=$GET(^XTMP(PXRRXTMP,FACILITY,"&&","POV",POV))+1
End DoDot:3
End DoDot:2
End DoDot:1
+17 GOTO NVISIT
+18 ;
DONE ;
+1 ;Sorting is done.
+2 IF '(PXRRQUE!$DATA(IO("S")))
DO DONE^PXRRBUSY("done")
EXIT ;
+1 ;
+2 ;Print the report information.
+3 IF PXRRQUE
Begin DoDot:1
+4 ;Start the printing that was queued but not scheduled.
+5 NEW DESC,ROUTINE,TASK
+6 SET ROUTINE="PXRRWLPR"
+7 SET DESC="Encounter Summary Report - print"
+8 SET ZTDTH=$$NOW^XLFDT
+9 SET TASK=^XTMP(PXRRXTMP,"PRZTSK")
+10 DO REQUE^PXRRQUE(DESC,ROUTINE,TASK)
End DoDot:1
+11 IF '$TEST
DO ^PXRRWLPR
+12 QUIT
+13 ;
