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 ---[H[J[2J[HPXRRPCR2 4671 printed Nov 22, 2024@17:41:04 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
