PXRRWLSE.m

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

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