PXRRWLS2.m

PXRRWLS2 ;ISA/Zoltan - Sort encounters for encounter summary report.;12/1/1998

 ;;1.0;PCE PATIENT CARE ENCOUNTER;**58,61**;Aug 12, 1996

 ;

 ; Code migrated from PXRRWLSE.

 ;

 ; Part 1:  migrated code.

SORT2 ; Migrated from PXRRWLSE

 I '(PXRRQUE!$D(IO("S"))) D INIT^PXRRBUSY(.BUSY)

 ;

 ;Location is true if we are screening by location.

 I $P(PXRRWLSC,U,1)="L" D

 . S LOCATION=1

 . S ^XTMP(PXRRXTMP,"STOIND","LOCATION")=""

 E  S LOCATION=0

 ;

 ;CSSCR is true if we want selected clinics.

 I $P($G(PXRRLCSC),U,1)="CS" S CSSCR=1

 E  S CSSCR=0

 ;

 ;CLINIC is true if we want clinics instead of hospital locations.

 I $P($G(PXRRLCSC),U,1)["C" D

 . S CLINIC=1

 . S BYCLOC=$S($P(PXRRLCSC,U,3):1,1:0)

 E  D

 . S CLINIC=0

 . S BYCLOC=0

 ;

 ;HSSCR is true if we want selected hospital locations.

 I $P($G(PXRRLCSC),U,1)="HS" S HSSCR=1

 E  S HSSCR=0

 ;

 ;PROVIDER is true if we select by provider.

 I $P($G(PXRRWLSC),U,1)="P" D

 . S PROVIDER=1

 . S ^XTMP(PXRRXTMP,"STOIND","PROVIDER")=""

 E  S PROVIDER=0

 ;

 ;PRVSCR is true if we have selected providers.

 I $D(NPL) S PRVSCR=1

 E  S PRVSCR=0

 ;

 ;Allow the task to be cleaned up upon successful completion.

 S ZTREQ="@"

 Q

 ;

VISIT2 ; Migrated from PXRRWLSE

 ;Clinic screen.

 I CSSCR D

 . S FOUND=0

 . S CLINIEN=$P(VISIT,U,8)

 . F IC=1:1:NCS I $P(PXRRCS(IC),U,2)=CLINIEN D  Q

 ..;Mark the clinic as being matched.

 .. S $P(PXRRCS(IC),U,4)="M"

 .. S HLOCNAM=$P(^DIC(40.7,CLINIEN,0),U,1)_U_CLINIEN

 .. S FOUND=1

 ;

 ;Hospital location screen.

 I HSSCR D

 . S FOUND=0

 . S HLOCIEN=$P(VISIT,U,22)

 . F IC=1:1:NHL I $P(PXRRLCHL(IC),U,2)=HLOCIEN D  Q

 ..;Mark the hospital location as being matched.

 .. S $P(PXRRLCHL(IC),U,4)="M"

 .. S CLINIEN=$P(^SC(HLOCIEN,0),U,7)

 .. S HLOCNAM=$P(^SC(HLOCIEN,0),U,1)_U_HLOCIEN

 .. S FOUND=1

 Q

 ;

PRV2 ; Migrated from PXRRWLSE

 ;At this point we have an encounter that can be added to the list.

 ;

 ;Get the hospital location or clinic and stop code.

 I $L(HLOCNAM)'>0 D

 . I 'CLINIC D

 .. ;Get the hospital location.

 .. S HLOCIEN=$P(VISIT,U,22)

 .. I HLOCIEN>0 D

 ... S HLOCNAM=$P(^SC(HLOCIEN,0),U,1)_U_HLOCIEN

 ... S CLINIEN=$P(^SC(HLOCIEN,0),U,7)

 .. E  D

 ...;No hospital location, see if we can at least find the clinic.

 ... S HLOCNAM="Unknown"

 ... S CLINIEN=$P(VISIT,U,8)

 . E  D

 .. ;Get the clinic.

 .. S CLINIEN=$P(VISIT,U,8)

 .. I $D(^DIC(40.7,CLINIEN,0))[0 S CLINIEN=0

 .. I CLINIEN>0 S HLOCNAM=$P(^DIC(40.7,CLINIEN,0),U,1)_U_CLINIEN

 .. E  S HLOCNAM="Unknown"

 ;

 ;Append the clinic stop code.

 I CLINIEN>0 S HLOCNAM=HLOCNAM_U_$P(^DIC(40.7,CLINIEN,0),U,2)

 ;

 I LOCATION S STOIND=HLOCNAM

 ;Make sure that all providers are stored with the person class.

 I PROVIDER D

 . I $P(PPNAME,U,3)="" D

 .. S PCLASS=$$OCCUP^PXBGPRV(NEWPIEN,BD,"",1,"")

 .. S PPNAME=PPNAME_U_$P(PCLASS,U,7)

 . S STOIND=PPNAME_U

 . I PXRRPRLL S STOIND=STOIND_HLOCNAM

 ;

 ;Save the patient information.

 S TEMP=^AUPNVSIT(VIEN,0)

 S DATE=$P(TEMP,U,1)

 S DAY=$P(DATE,".",1)

 S DFN=$P(TEMP,U,5)

 ;Get the patient status, 1 is in, 0 is out.

 S INOUT=$P(VISIT150,U,2)

 I $L(INOUT)=0 S INOUT=-1

 Q

 ;

GC2 ; Migrated from PXRRWLSE

 S CPT=$P(^AUPNVCPT(IC,0),U,1)

 I +CPT'>0 D

 . W !,"WARNING AUPNVCPT IS CORRUPTED! ENTRY ",IC," does not have a CPT code."

 . S CPT=0

 E  D

 . S EM=$P($G(^IBE(357.69,CPT,0)),U,5)

 . I EM="" S EM=0

 ;

 ;Increment the CPT and E&M counts.

 S ^XTMP(PXRRXTMP,FACILITY,STOIND,"CPT")=$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"CPT"))+1

 S ^XTMP(PXRRXTMP,FACILITY,STOIND,"EM",EM)=$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"EM",EM))+1

 ;Calculate totals by facility for multiple provider encounters.

 I MULTPR=1 D

 . D FTOT(FACILITY,"&&","CPT")

 . D FTOT1(FACILITY,"&&","EM",EM)

 Q

 ;

 ;Totals for multiple provider encounters - used in PXRRWLPR.

FTOT(FL,FLD,FL1) ;

 S ^XTMP(PXRRXTMP,FL,FLD,FL1)=$G(^XTMP(PXRRXTMP,FL,FLD,FL1))+1

 Q

FTOT1(FL,FLD,FL1,FL2) ;

 S ^XTMP(PXRRXTMP,FL,FLD,FL1,FL2)=$G(^XTMP(PXRRXTMP,FL,FLD,FL1,FL2))+1

 Q

 ;

NF2 ; Migrated from PXRRWLSE

 ;Count the total unique patients and visits at the facility.

 S TOTUNIQ=0

 S TOTVIS=0

 S VISITS(0)=0

 S VISITS(1)=0

 S DFN=0

 F  S DFN=$O(^TMP(PXRRXTMP,$J,FACILITY,"&","PATIENT",DFN)) Q:DFN=""  D

 . S TOTUNIQ=TOTUNIQ+1

 . S DAY=""

 . F  S DAY=$O(^TMP(PXRRXTMP,$J,FACILITY,"&","PATIENT",DFN,DAY)) Q:DAY=""  D

 .. S TOTVIS=TOTVIS+1

 .. S INOUT=-1

 .. F  S INOUT=$O(^TMP(PXRRXTMP,$J,FACILITY,"&","PATIENT",DFN,DAY,INOUT)) Q:INOUT=""  D

 ... S VISITS(INOUT)=VISITS(INOUT)+1

 S ^XTMP(PXRRXTMP,FACILITY,"&","TOTUNIQ")=TOTUNIQ

 S ^XTMP(PXRRXTMP,FACILITY,"&","TOTVIS")=TOTVIS

 S ^XTMP(PXRRXTMP,FACILITY,"&","TOTINOUT",0)=VISITS(0)

 S ^XTMP(PXRRXTMP,FACILITY,"&","TOTINOUT",1)=VISITS(1)

 Q

 ;

CLOC2 ; Migrated from PXRRWLSE

 ;Save this to count the total number of unique patients and

 ;the total unique in/out patient encounters.

 S ^TMP(PXRRXTMP,$J,FACILITY,"&","PATIENT",DFN,DAY,INOUT)=""

 ;

 ;Save this to count the unique in/out patient encounters.

 S ^TMP(PXRRXTMP,$J,FACILITY,STOIND,"PATIENT",DFN,DAY,INOUT)=""

 ;

 ;Save this information so we can search for appointments in PXRRWLSA.

 S ^XTMP(PXRRXTMP,FACILITY,STOIND,"PATIENT",DFN,DATE,VIEN)=MULTPR

 ;

 ;Increment the encounter count.

 S ^XTMP(PXRRXTMP,FACILITY,STOIND,"TOTENC")=$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"TOTENC"))+1

 ;

 ;Calculate totals by facility for multiple provider encounters.

 I MULTPR=1 D FTOT(FACILITY,"&&","TOTENC")

 Q

PXRRWLS2  ;ISA/Zoltan - Sort encounters for encounter summary report.;12/1/1998

 +1       ;;1.0;PCE PATIENT CARE ENCOUNTER;**58,61**;Aug 12, 1996

 +2       ;

 +3       ; Code migrated from PXRRWLSE.

 +4       ;

 +5       ; Part 1:  migrated code.

SORT2     ; Migrated from PXRRWLSE

 +1        IF '(PXRRQUE!$DATA(IO("S")))

               DO INIT^PXRRBUSY(.BUSY)

 +2       ;

 +3       ;Location is true if we are screening by location.

 +4        IF $PIECE(PXRRWLSC,U,1)="L"

               Begin DoDot:1

 +5                SET LOCATION=1

 +6                SET ^XTMP(PXRRXTMP,"STOIND","LOCATION")=""

               End DoDot:1

 +7       IF '$TEST

               SET LOCATION=0

 +8       ;

 +9       ;CSSCR is true if we want selected clinics.

 +10       IF $PIECE($GET(PXRRLCSC),U,1)="CS"

               SET CSSCR=1

 +11      IF '$TEST

               SET CSSCR=0

 +12      ;

 +13      ;CLINIC is true if we want clinics instead of hospital locations.

 +14       IF $PIECE($GET(PXRRLCSC),U,1)["C"

               Begin DoDot:1

 +15               SET CLINIC=1

 +16               SET BYCLOC=$SELECT($PIECE(PXRRLCSC,U,3):1,1:0)

               End DoDot:1

 +17      IF '$TEST

               Begin DoDot:1

 +18               SET CLINIC=0

 +19               SET BYCLOC=0

               End DoDot:1

 +20      ;

 +21      ;HSSCR is true if we want selected hospital locations.

 +22       IF $PIECE($GET(PXRRLCSC),U,1)="HS"

               SET HSSCR=1

 +23      IF '$TEST

               SET HSSCR=0

 +24      ;

 +25      ;PROVIDER is true if we select by provider.

 +26       IF $PIECE($GET(PXRRWLSC),U,1)="P"

               Begin DoDot:1

 +27               SET PROVIDER=1

 +28               SET ^XTMP(PXRRXTMP,"STOIND","PROVIDER")=""

               End DoDot:1

 +29      IF '$TEST

               SET PROVIDER=0

 +30      ;

 +31      ;PRVSCR is true if we have selected providers.

 +32       IF $DATA(NPL)

               SET PRVSCR=1

 +33      IF '$TEST

               SET PRVSCR=0

 +34      ;

 +35      ;Allow the task to be cleaned up upon successful completion.

 +36       SET ZTREQ="@"

 +37       QUIT 

 +38      ;

VISIT2    ; Migrated from PXRRWLSE

 +1       ;Clinic screen.

 +2        IF CSSCR

               Begin DoDot:1

 +3                SET FOUND=0

 +4                SET CLINIEN=$PIECE(VISIT,U,8)

 +5                FOR IC=1:1:NCS

                       IF $PIECE(PXRRCS(IC),U,2)=CLINIEN

                           Begin DoDot:2

 +6       ;Mark the clinic as being matched.

 +7                            SET $PIECE(PXRRCS(IC),U,4)="M"

 +8                            SET HLOCNAM=$PIECE(^DIC(40.7,CLINIEN,0),U,1)_U_CLINIEN

 +9                            SET FOUND=1

                           End DoDot:2

                           QUIT 

               End DoDot:1

 +10      ;

 +11      ;Hospital location screen.

 +12       IF HSSCR

               Begin DoDot:1

 +13               SET FOUND=0

 +14               SET HLOCIEN=$PIECE(VISIT,U,22)

 +15               FOR IC=1:1:NHL

                       IF $PIECE(PXRRLCHL(IC),U,2)=HLOCIEN

                           Begin DoDot:2

 +16      ;Mark the hospital location as being matched.

 +17                           SET $PIECE(PXRRLCHL(IC),U,4)="M"

 +18                           SET CLINIEN=$PIECE(^SC(HLOCIEN,0),U,7)

 +19                           SET HLOCNAM=$PIECE(^SC(HLOCIEN,0),U,1)_U_HLOCIEN

 +20                           SET FOUND=1

                           End DoDot:2

                           QUIT 

               End DoDot:1

 +21       QUIT 

 +22      ;

PRV2      ; Migrated from PXRRWLSE

 +1       ;At this point we have an encounter that can be added to the list.

 +2       ;

 +3       ;Get the hospital location or clinic and stop code.

 +4        IF $LENGTH(HLOCNAM)'>0

               Begin DoDot:1

 +5                IF 'CLINIC

                       Begin DoDot:2

 +6       ;Get the hospital location.

 +7                        SET HLOCIEN=$PIECE(VISIT,U,22)

 +8                        IF HLOCIEN>0

                               Begin DoDot:3

 +9                                SET HLOCNAM=$PIECE(^SC(HLOCIEN,0),U,1)_U_HLOCIEN

 +10                               SET CLINIEN=$PIECE(^SC(HLOCIEN,0),U,7)

                               End DoDot:3

 +11                      IF '$TEST

                               Begin DoDot:3

 +12      ;No hospital location, see if we can at least find the clinic.

 +13                               SET HLOCNAM="Unknown"

 +14                               SET CLINIEN=$PIECE(VISIT,U,8)

                               End DoDot:3

                       End DoDot:2

 +15              IF '$TEST

                       Begin DoDot:2

 +16      ;Get the clinic.

 +17                       SET CLINIEN=$PIECE(VISIT,U,8)

 +18                       IF $DATA(^DIC(40.7,CLINIEN,0))[0

                               SET CLINIEN=0

 +19                       IF CLINIEN>0

                               SET HLOCNAM=$PIECE(^DIC(40.7,CLINIEN,0),U,1)_U_CLINIEN

 +20                      IF '$TEST

                               SET HLOCNAM="Unknown"

                       End DoDot:2

               End DoDot:1

 +21      ;

 +22      ;Append the clinic stop code.

 +23       IF CLINIEN>0

               SET HLOCNAM=HLOCNAM_U_$PIECE(^DIC(40.7,CLINIEN,0),U,2)

 +24      ;

 +25       IF LOCATION

               SET STOIND=HLOCNAM

 +26      ;Make sure that all providers are stored with the person class.

 +27       IF PROVIDER

               Begin DoDot:1

 +28               IF $PIECE(PPNAME,U,3)=""

                       Begin DoDot:2

 +29                       SET PCLASS=$$OCCUP^PXBGPRV(NEWPIEN,BD,"",1,"")

 +30                       SET PPNAME=PPNAME_U_$PIECE(PCLASS,U,7)

                       End DoDot:2

 +31               SET STOIND=PPNAME_U

 +32               IF PXRRPRLL

                       SET STOIND=STOIND_HLOCNAM

               End DoDot:1

 +33      ;

 +34      ;Save the patient information.

 +35       SET TEMP=^AUPNVSIT(VIEN,0)

 +36       SET DATE=$PIECE(TEMP,U,1)

 +37       SET DAY=$PIECE(DATE,".",1)

 +38       SET DFN=$PIECE(TEMP,U,5)

 +39      ;Get the patient status, 1 is in, 0 is out.

 +40       SET INOUT=$PIECE(VISIT150,U,2)

 +41       IF $LENGTH(INOUT)=0

               SET INOUT=-1

 +42       QUIT 

 +43      ;

GC2       ; Migrated from PXRRWLSE

 +1        SET CPT=$PIECE(^AUPNVCPT(IC,0),U,1)

 +2        IF +CPT'>0

               Begin DoDot:1

 +3                WRITE !,"WARNING AUPNVCPT IS CORRUPTED! ENTRY ",IC," does not have a CPT code."

 +4                SET CPT=0

               End DoDot:1

 +5       IF '$TEST

               Begin DoDot:1

 +6                SET EM=$PIECE($GET(^IBE(357.69,CPT,0)),U,5)

 +7                IF EM=""

                       SET EM=0

               End DoDot:1

 +8       ;

 +9       ;Increment the CPT and E&M counts.

 +10       SET ^XTMP(PXRRXTMP,FACILITY,STOIND,"CPT")=$GET(^XTMP(PXRRXTMP,FACILITY,STOIND,"CPT"))+1

 +11       SET ^XTMP(PXRRXTMP,FACILITY,STOIND,"EM",EM)=$GET(^XTMP(PXRRXTMP,FACILITY,STOIND,"EM",EM))+1

 +12      ;Calculate totals by facility for multiple provider encounters.

 +13       IF MULTPR=1

               Begin DoDot:1

 +14               DO FTOT(FACILITY,"&&","CPT")

 +15               DO FTOT1(FACILITY,"&&","EM",EM)

               End DoDot:1

 +16       QUIT 

 +17      ;

 +18      ;Totals for multiple provider encounters - used in PXRRWLPR.

FTOT(FL,FLD,FL1) ;

 +1        SET ^XTMP(PXRRXTMP,FL,FLD,FL1)=$GET(^XTMP(PXRRXTMP,FL,FLD,FL1))+1

 +2        QUIT 

FTOT1(FL,FLD,FL1,FL2) ;

 +1        SET ^XTMP(PXRRXTMP,FL,FLD,FL1,FL2)=$GET(^XTMP(PXRRXTMP,FL,FLD,FL1,FL2))+1

 +2        QUIT 

 +3       ;

NF2       ; Migrated from PXRRWLSE

 +1       ;Count the total unique patients and visits at the facility.

 +2        SET TOTUNIQ=0

 +3        SET TOTVIS=0

 +4        SET VISITS(0)=0

 +5        SET VISITS(1)=0

 +6        SET DFN=0

 +7        FOR 

               SET DFN=$ORDER(^TMP(PXRRXTMP,$JOB,FACILITY,"&","PATIENT",DFN))

               IF DFN=""

                   QUIT 

               Begin DoDot:1

 +8                SET TOTUNIQ=TOTUNIQ+1

 +9                SET DAY=""

 +10               FOR 

                       SET DAY=$ORDER(^TMP(PXRRXTMP,$JOB,FACILITY,"&","PATIENT",DFN,DAY))

                       IF DAY=""

                           QUIT 

                       Begin DoDot:2

 +11                       SET TOTVIS=TOTVIS+1

 +12                       SET INOUT=-1

 +13                       FOR 

                               SET INOUT=$ORDER(^TMP(PXRRXTMP,$JOB,FACILITY,"&","PATIENT",DFN,DAY,INOUT))

                               IF INOUT=""

                                   QUIT 

                               Begin DoDot:3

 +14                               SET VISITS(INOUT)=VISITS(INOUT)+1

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +15       SET ^XTMP(PXRRXTMP,FACILITY,"&","TOTUNIQ")=TOTUNIQ

 +16       SET ^XTMP(PXRRXTMP,FACILITY,"&","TOTVIS")=TOTVIS

 +17       SET ^XTMP(PXRRXTMP,FACILITY,"&","TOTINOUT",0)=VISITS(0)

 +18       SET ^XTMP(PXRRXTMP,FACILITY,"&","TOTINOUT",1)=VISITS(1)

 +19       QUIT 

 +20      ;

CLOC2     ; Migrated from PXRRWLSE

 +1       ;Save this to count the total number of unique patients and

 +2       ;the total unique in/out patient encounters.

 +3        SET ^TMP(PXRRXTMP,$JOB,FACILITY,"&","PATIENT",DFN,DAY,INOUT)=""

 +4       ;

 +5       ;Save this to count the unique in/out patient encounters.

 +6        SET ^TMP(PXRRXTMP,$JOB,FACILITY,STOIND,"PATIENT",DFN,DAY,INOUT)=""

 +7       ;

 +8       ;Save this information so we can search for appointments in PXRRWLSA.

 +9        SET ^XTMP(PXRRXTMP,FACILITY,STOIND,"PATIENT",DFN,DATE,VIEN)=MULTPR

 +10      ;

 +11      ;Increment the encounter count.

 +12       SET ^XTMP(PXRRXTMP,FACILITY,STOIND,"TOTENC")=$GET(^XTMP(PXRRXTMP,FACILITY,STOIND,"TOTENC"))+1

 +13      ;

 +14      ;Calculate totals by facility for multiple provider encounters.

 +15       IF MULTPR=1

               DO FTOT(FACILITY,"&&","TOTENC")

 +16       QUIT