PXRRWLSA.m

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 ---PXRRWLSA   2219     printed  Feb 18, 2025@23:57:37                                                                                                                                                                                                    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      ;