PXRRWLS2 ;ISA/Zoltan - Sort encounters for encounter summary report.;12/1/1998
;;1.0;PCE PATIENT CARE ENCOUNTER;**58,61,133**;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 CLINIEN="" S CLINIEN=0
.. I CLINIEN,$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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRRWLS2 5526 printed Dec 13, 2024@02:31:19 Page 2
PXRRWLS2 ;ISA/Zoltan - Sort encounters for encounter summary report.;12/1/1998
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**58,61,133**;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 CLINIEN=""
SET CLINIEN=0
+19 IF CLINIEN
IF $DATA(^DIC(40.7,CLINIEN,0))[0
SET CLINIEN=0
+20 IF CLINIEN>0
SET HLOCNAM=$PIECE(^DIC(40.7,CLINIEN,0),U,1)_U_CLINIEN
+21 IF '$TEST
SET HLOCNAM="Unknown"
End DoDot:2
End DoDot:1
+22 ;
+23 ;Append the clinic stop code.
+24 IF CLINIEN>0
SET HLOCNAM=HLOCNAM_U_$PIECE(^DIC(40.7,CLINIEN,0),U,2)
+25 ;
+26 IF LOCATION
SET STOIND=HLOCNAM
+27 ;Make sure that all providers are stored with the person class.
+28 IF PROVIDER
Begin DoDot:1
+29 IF $PIECE(PPNAME,U,3)=""
Begin DoDot:2
+30 SET PCLASS=$$OCCUP^PXBGPRV(NEWPIEN,BD,"",1,"")
+31 SET PPNAME=PPNAME_U_$PIECE(PCLASS,U,7)
End DoDot:2
+32 SET STOIND=PPNAME_U
+33 IF PXRRPRLL
SET STOIND=STOIND_HLOCNAM
End DoDot:1
+34 ;
+35 ;Save the patient information.
+36 SET TEMP=^AUPNVSIT(VIEN,0)
+37 SET DATE=$PIECE(TEMP,U,1)
+38 SET DAY=$PIECE(DATE,".",1)
+39 SET DFN=$PIECE(TEMP,U,5)
+40 ;Get the patient status, 1 is in, 0 is out.
+41 SET INOUT=$PIECE(VISIT150,U,2)
+42 IF $LENGTH(INOUT)=0
SET INOUT=-1
+43 QUIT
+44 ;
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
