PXRRPCR2.m

PXRRPCR2 ;HIN/MjK - Clinic Specfic Workload Reports ;6/7/96

 ;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996

ACTIVTY ;:_._._._._._._._._._._._.Caseload Activity_._._._._._._._._._._._.

 S PXRRQ=1 D HDR^PXRRPCR W ?11,"Report Date Range: ",$$FMTE^XLFDT($P(PXRRBDT,"."))," through ",$$FMTE^XLFDT($P(PXRREDT,"."))

 I $D(PXRSTPNM)  W !?22,"Clinic Stop: ",PXRSTPNM G HDR

 W !?2,"Clinic(s): ",$P($G(PXRRCLIN(1)),U) F I=2:1 Q:'$D(PXRRCLIN(I))  D

 . I ($L($P(PXRRCLIN(I),U))+$X+3)<IOM W ", ",$P(PXRRCLIN(I),U) Q

 . W !?13,$P($G(PXRRCLIN(I)),U)

HDR W !?2,"CASELOAD ACTIVITY...patients' hospital admissions/discharges, emergency room",!?2,"visits and critical lab values ;address,phone,future appts",!

NONE ;_._._.If no Pateint Activity_._._.

 I '$D(^TMP($J,"PATIENT")) W !,"No patients were recorded to have these actitvites within the",!,"selected date range." Q

ADM ;A = Patient DFN ;B/C = Admission Date ;E=Discharge Date ;T = Line Tag

 W !,"____________________________ADMISSIONS/DISCHARGES____________________________",! S T="ADMH^PXRRPCR"

 I '$D(^TMP($J,"ADM")) W !?5,"o There were no ADMISSIONS for these patients during this date range.",! G ER

 D @T S A=0 F  S A=$O(^TMP($J,"ADM",A)) Q:'A!('PXRRQ)  S B=0 F  S B=$O(^TMP($J,"ADM",A,B)) Q:'B!('PXRRQ)  S C=$$FMTE^XLFDT(B),E=$$FMTE^XLFDT($P($P(^TMP($J,"ADM",A,B),U),".")) D CHK:$Y>(IOSL-12) Q:'PXRRQ  D

 .  W !,$P(C,"@"),?13,E,?30,$E($P(^DPT(A,0),U),1,25)

 .  W ?57,$P(^DPT(A,0),U,9)

 .  W ?69,$P(^TMP($J,"ADM",A,B),U,2) W:'$O(^(B)) !

 .  I '$O(^TMP($J,"ADM",A,B)) D

 .. W ?2,"Addr: ",$S($P($G(^(B)),U,3)'="":$P($G(^(B)),U,3)_" "_$P($G(^(B)),U,4),1:"Not Available")_" / "

 .. W $S($P($G(^(B)),U,5)'="":$E($P($G(^(B)),U,5),1,20),1:"No TOWN")_"  "

 .. W $P($G(^(B)),U,6)_" "

 .. W $S($P($G(^(B)),U,7)'="":$P($G(^(B)),U,7),1:"No ZIP")_" / "

 .. W "Ph: "_$S($P($G(^(B)),U,8)'="":$P($G(^(B)),U,8),1:"No PHONE"),!

 .. D CHK:$Y>(IOSL-11) Q:'PXRRQ

 .. D FUT W !?32,"~~~~~~~~~~~~"

 Q:'PXRRQ

ER ;A = Patient DFN ;B/C = Visit Date ;T = Line Tag

 W !,"_____________________________EMERGENCY ROOM VISITS_____________________________",! S T="ERH^PXRRPCR"

 I '$D(^TMP($J,"ER")) W !?5,"o There were no ER VISITS for these patients during this date range.",! G LAB

 D @T S A=0 F  S A=$O(^TMP($J,"ER",A)) Q:'A!('PXRRQ)  S B=0 F  S B=$O(^TMP($J,"ER",A,B)) Q:'B  S C=$$FMTE^XLFDT(B) D CHK:$Y>(IOSL-6) Q:'PXRRQ  D

 .  W !,C,?27,$E($P(^DPT(A,0),U),1,27),?57,$P(^DPT(A,0),U,9)

 .  I '$O(^TMP($J,"ER",A,B)) D

 .. W !?2,"Addr: ",$S($P($G(^TMP($J,"ER",A,B)),U)'="":$P($G(^(B)),U)_$P($G(^(B)),U,2),1:"No Address")_" / "

 .. W $S($P($G(^TMP($J,"ER",A,B)),U,3)'="":$P($G(^(B)),U,3),1:"No TOWN")_"  "

 .. W $P($G(^TMP($J,"ER",A,B)),U,4)_" "

 .. W $S($P($G(^TMP($J,"ER",A,B)),U,5)'="":$P($G(^(B)),U,5),1:"No ZIP")_"  "

 .. W "PH: "_$S($P($G(^(B)),U,6)'="":$P($G(^(B)),U,6),1:"No Phone"),!

 .. D CHK:$Y>(IOSL-6) Q:'PXRRQ  D FUT W !?32,"~~~~~~~~~~~~"

 Q:'PXRRQ

LAB ;A = Patient DFN ;B/C = Lab Date ;E =Lab Test Field No. ;T =Line Tag

 W !,"____________________________CRITICAL LAB VALUES____________________________",! S T="LABH^PXRRPCR"

 I '$D(^TMP($J,"LAB")) W !?5,"o There were no CRITICAL LABS for these patients during this date range. ",! G Q

 D @T S A=0 F  S A=$O(^TMP($J,"LAB",A)) Q:'A!('PXRRQ)  S B=0 F  S B=$O(^TMP($J,"LAB",A,B)) Q:'B  S C=$$FMTE^XLFDT(B),E=0 F  S E=$O(^TMP($J,"LAB",A,B,E)) Q:'E  D CHK:$Y>(IOSL-6) Q:'PXRRQ  D

 .  W !,$P(C,"@"),?13,$E($P(^DPT(A,0),U),1,20),?35,$P(^DPT(A,0),U,9)

 .  W ?48,$P($G(^TMP($J,"LAB",A,B,E)),U)

 .  W ?75,$P($G(^TMP($J,"LAB",A,B,E)),U,8)

 .  I '$O(^TMP($J,"LAB",A,B))&('$O(^TMP($J,"LAB",A,B,E))) D

 .. W !?2,"Addr. ",$S($P($G(^TMP($J,"LAB",A,B,E)),U,2)'="":$P($G(^(E)),U,2),1:"No Address")_" / "

 .. W $S($P($G(^TMP($J,"LAB",A,B,E)),U,4)'="":$P($G(^(E)),U,4),1:"No TOWN")_"  "

 .. W $P($G(^TMP($J,"LAB",A,B,E)),U,5)_" "

 .. W $S($P($G(^TMP($J,"LAB",A,B,E)),U,6)'="":$P($G(^(E)),U,6),1:"No ZIP")_" / "

 .. W "Ph: ",$S($P($G(^TMP($J,"LAB",A,B,E)),U,7)'="":$P($G(^(E)),U,7),1:"Not Avail."),!

 .. D CHK:$Y>(IOSL-6) Q:'PXRRQ

 .. D FUT W !?32,"~~~~~~~~~~~~"

Q W !,"______________________________________________________________________________",! ;?2,"TOTAL UNIQUE PATIENTS: ",PXRRTPAT,?50,"TOTAL VISITS: ",PXRRTVS

 Q

FUT ;Z/Q = Fut Appointment Date ;A = Patient DFN

 I '$D(^TMP($J,"FUT",A)) W !?2,"Future Appt. Dt:  ",?22,"NONE" Q

 S Z=0 F  S Z=$O(^TMP($J,"FUT",A,Z)) Q:'Z  S Q=$$FMTE^XLFDT(Z) D

 . W !?8,"Fut. Appt. Dt:  ",Q,?41," - CL: ",$E($G(^TMP($J,"FUT",A,Z)),1,30)

 D CHK:$Y>(IOSL-4) Q:'PXRRQ

 Q

CHK ;Hold Screen, Format for Home Device Viewing

 I IOST?1"C-".E S DIR(0)="E" D ^DIR S PXRRQ=$S(Y:1,1:0) K DIR

 I +PXRRQ D HDR^PXRRPCR,@T

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PXRRPCR2   4671     printed  Apr 23, 2025@18:45:22                                                                                                                                                                                                    Page 2

PXRRPCR2  ;HIN/MjK - Clinic Specfic Workload Reports ;6/7/96

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

ACTIVTY   ;:_._._._._._._._._._._._.Caseload Activity_._._._._._._._._._._._.

 +1        SET PXRRQ=1

           DO HDR^PXRRPCR

           WRITE ?11,"Report Date Range: ",$$FMTE^XLFDT($PIECE(PXRRBDT,"."))," through ",$$FMTE^XLFDT($PIECE(PXRREDT,"."))

 +2        IF $DATA(PXRSTPNM)

               WRITE !?22,"Clinic Stop: ",PXRSTPNM

               GOTO HDR

 +3        WRITE !?2,"Clinic(s): ",$PIECE($GET(PXRRCLIN(1)),U)

           FOR I=2:1

               if '$DATA(PXRRCLIN(I))

                   QUIT 

               Begin DoDot:1

 +4                IF ($LENGTH($PIECE(PXRRCLIN(I),U))+$X+3)<IOM

                       WRITE ", ",$PIECE(PXRRCLIN(I),U)

                       QUIT 

 +5                WRITE !?13,$PIECE($GET(PXRRCLIN(I)),U)

               End DoDot:1

HDR        WRITE !?2,"CASELOAD ACTIVITY...patients' hospital admissions/discharges, emergency room",!?2,"visits and critical lab values ;address,phone,future appts",!

NONE      ;_._._.If no Pateint Activity_._._.

 +1        IF '$DATA(^TMP($JOB,"PATIENT"))

               WRITE !,"No patients were recorded to have these actitvites within the",!,"selected date range."

               QUIT 

ADM       ;A = Patient DFN ;B/C = Admission Date ;E=Discharge Date ;T = Line Tag

 +1        WRITE !,"____________________________ADMISSIONS/DISCHARGES____________________________",!

           SET T="ADMH^PXRRPCR"

 +2        IF '$DATA(^TMP($JOB,"ADM"))

               WRITE !?5,"o There were no ADMISSIONS for these patients during this date range.",!

               GOTO ER

 +3        DO @T

           SET A=0

           FOR 

               SET A=$ORDER(^TMP($JOB,"ADM",A))

               if 'A!('PXRRQ)

                   QUIT 

               SET B=0

               FOR 

                   SET B=$ORDER(^TMP($JOB,"ADM",A,B))

                   if 'B!('PXRRQ)

                       QUIT 

                   SET C=$$FMTE^XLFDT(B)

                   SET E=$$FMTE^XLFDT($PIECE($PIECE(^TMP($JOB,"ADM",A,B),U),"."))

                   if $Y>(IOSL-12)

                       DO CHK

                   if 'PXRRQ

                       QUIT 

                   Begin DoDot:1

 +4                    WRITE !,$PIECE(C,"@"),?13,E,?30,$EXTRACT($PIECE(^DPT(A,0),U),1,25)

 +5                    WRITE ?57,$PIECE(^DPT(A,0),U,9)

 +6                    WRITE ?69,$PIECE(^TMP($JOB,"ADM",A,B),U,2)

                       if '$ORDER(^(B))

                           WRITE !

 +7                    IF '$ORDER(^TMP($JOB,"ADM",A,B))

                           Begin DoDot:2

 +8                            WRITE ?2,"Addr: ",$SELECT($PIECE($GET(^(B)),U,3)'="":$PIECE($GET(^(B)),U,3)_" "_$PIECE($GET(^(B)),U,4),1:"Not Available")_" / "

 +9                            WRITE $SELECT($PIECE($GET(^(B)),U,5)'="":$EXTRACT($PIECE($GET(^(B)),U,5),1,20),1:"No TOWN")_"  "

 +10                           WRITE $PIECE($GET(^(B)),U,6)_" "

 +11                           WRITE $SELECT($PIECE($GET(^(B)),U,7)'="":$PIECE($GET(^(B)),U,7),1:"No ZIP")_" / "

 +12                           WRITE "Ph: "_$SELECT($PIECE($GET(^(B)),U,8)'="":$PIECE($GET(^(B)),U,8),1:"No PHONE"),!

 +13                           if $Y>(IOSL-11)

                                   DO CHK

                               if 'PXRRQ

                                   QUIT 

 +14                           DO FUT

                               WRITE !?32,"~~~~~~~~~~~~"

                           End DoDot:2

                   End DoDot:1

 +15       if 'PXRRQ

               QUIT 

ER        ;A = Patient DFN ;B/C = Visit Date ;T = Line Tag

 +1        WRITE !,"_____________________________EMERGENCY ROOM VISITS_____________________________",!

           SET T="ERH^PXRRPCR"

 +2        IF '$DATA(^TMP($JOB,"ER"))

               WRITE !?5,"o There were no ER VISITS for these patients during this date range.",!

               GOTO LAB

 +3        DO @T

           SET A=0

           FOR 

               SET A=$ORDER(^TMP($JOB,"ER",A))

               if 'A!('PXRRQ)

                   QUIT 

               SET B=0

               FOR 

                   SET B=$ORDER(^TMP($JOB,"ER",A,B))

                   if 'B

                       QUIT 

                   SET C=$$FMTE^XLFDT(B)

                   if $Y>(IOSL-6)

                       DO CHK

                   if 'PXRRQ

                       QUIT 

                   Begin DoDot:1

 +4                    WRITE !,C,?27,$EXTRACT($PIECE(^DPT(A,0),U),1,27),?57,$PIECE(^DPT(A,0),U,9)

 +5                    IF '$ORDER(^TMP($JOB,"ER",A,B))

                           Begin DoDot:2

 +6                            WRITE !?2,"Addr: ",$SELECT($PIECE($GET(^TMP($JOB,"ER",A,B)),U)'="":$PIECE($GET(^(B)),U)_$PIECE($GET(^(B)),U,2),1:"No Address")_" / "

 +7                            WRITE $SELECT($PIECE($GET(^TMP($JOB,"ER",A,B)),U,3)'="":$PIECE($GET(^(B)),U,3),1:"No TOWN")_"  "

 +8                            WRITE $PIECE($GET(^TMP($JOB,"ER",A,B)),U,4)_" "

 +9                            WRITE $SELECT($PIECE($GET(^TMP($JOB,"ER",A,B)),U,5)'="":$PIECE($GET(^(B)),U,5),1:"No ZIP")_"  "

 +10                           WRITE "PH: "_$SELECT($PIECE($GET(^(B)),U,6)'="":$PIECE($GET(^(B)),U,6),1:"No Phone"),!

 +11                           if $Y>(IOSL-6)

                                   DO CHK

                               if 'PXRRQ

                                   QUIT 

                               DO FUT

                               WRITE !?32,"~~~~~~~~~~~~"

                           End DoDot:2

                   End DoDot:1

 +12       if 'PXRRQ

               QUIT 

LAB       ;A = Patient DFN ;B/C = Lab Date ;E =Lab Test Field No. ;T =Line Tag

 +1        WRITE !,"____________________________CRITICAL LAB VALUES____________________________",!

           SET T="LABH^PXRRPCR"

 +2        IF '$DATA(^TMP($JOB,"LAB"))

               WRITE !?5,"o There were no CRITICAL LABS for these patients during this date range. ",!

               GOTO Q

 +3        DO @T

           SET A=0

           FOR 

               SET A=$ORDER(^TMP($JOB,"LAB",A))

               if 'A!('PXRRQ)

                   QUIT 

               SET B=0

               FOR 

                   SET B=$ORDER(^TMP($JOB,"LAB",A,B))

                   if 'B

                       QUIT 

                   SET C=$$FMTE^XLFDT(B)

                   SET E=0

                   FOR 

                       SET E=$ORDER(^TMP($JOB,"LAB",A,B,E))

                       if 'E

                           QUIT 

                       if $Y>(IOSL-6)

                           DO CHK

                       if 'PXRRQ

                           QUIT 

                       Begin DoDot:1

 +4                        WRITE !,$PIECE(C,"@"),?13,$EXTRACT($PIECE(^DPT(A,0),U),1,20),?35,$PIECE(^DPT(A,0),U,9)

 +5                        WRITE ?48,$PIECE($GET(^TMP($JOB,"LAB",A,B,E)),U)

 +6                        WRITE ?75,$PIECE($GET(^TMP($JOB,"LAB",A,B,E)),U,8)

 +7                        IF '$ORDER(^TMP($JOB,"LAB",A,B))&('$ORDER(^TMP($JOB,"LAB",A,B,E)))

                               Begin DoDot:2

 +8                                WRITE !?2,"Addr. ",$SELECT($PIECE($GET(^TMP($JOB,"LAB",A,B,E)),U,2)'="":$PIECE($GET(^(E)),U,2),1:"No Address")_" / "

 +9                                WRITE $SELECT($PIECE($GET(^TMP($JOB,"LAB",A,B,E)),U,4)'="":$PIECE($GET(^(E)),U,4),1:"No TOWN")_"  "

 +10                               WRITE $PIECE($GET(^TMP($JOB,"LAB",A,B,E)),U,5)_" "

 +11                               WRITE $SELECT($PIECE($GET(^TMP($JOB,"LAB",A,B,E)),U,6)'="":$PIECE($GET(^(E)),U,6),1:"No ZIP")_" / "

 +12                               WRITE "Ph: ",$SELECT($PIECE($GET(^TMP($JOB,"LAB",A,B,E)),U,7)'="":$PIECE($GET(^(E)),U,7),1:"Not Avail."),!

 +13                               if $Y>(IOSL-6)

                                       DO CHK

                                   if 'PXRRQ

                                       QUIT 

 +14                               DO FUT

                                   WRITE !?32,"~~~~~~~~~~~~"

                               End DoDot:2

                       End DoDot:1

Q         ;?2,"TOTAL UNIQUE PATIENTS: ",PXRRTPAT,?50,"TOTAL VISITS: ",PXRRTVS

           WRITE !,"______________________________________________________________________________",!

 +1        QUIT 

FUT       ;Z/Q = Fut Appointment Date ;A = Patient DFN

 +1        IF '$DATA(^TMP($JOB,"FUT",A))

               WRITE !?2,"Future Appt. Dt:  ",?22,"NONE"

               QUIT 

 +2        SET Z=0

           FOR 

               SET Z=$ORDER(^TMP($JOB,"FUT",A,Z))

               if 'Z

                   QUIT 

               SET Q=$$FMTE^XLFDT(Z)

               Begin DoDot:1

 +3                WRITE !?8,"Fut. Appt. Dt:  ",Q,?41," - CL: ",$EXTRACT($GET(^TMP($JOB,"FUT",A,Z)),1,30)

               End DoDot:1

 +4        if $Y>(IOSL-4)

               DO CHK

           if 'PXRRQ

               QUIT 

 +5        QUIT 

CHK       ;Hold Screen, Format for Home Device Viewing

 +1        IF IOST?1"C-".E

               SET DIR(0)="E"

               DO ^DIR

               SET PXRRQ=$SELECT(Y:1,1:0)

               KILL DIR

 +2        IF +PXRRQ

               DO HDR^PXRRPCR

               DO @T

 +3        QUIT