PXRRPCR1 ;HIN/MjK - Clinic Specfic Workload Reports ;6/7/96
;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
VIS ;_._._._._._._._._._._._.Clinic Workload_._._._._._._._._._._._.
D HDR^PXRRPCR S PXRRQ=1 I $D(PXRSTPNM) W !?1,"Clinic Stop: ",PXRSTPNM,!
W ?1,"Encounter Date Range: ",$$FMTE^XLFDT($P(PXRRBDT,"."))," through ",$$FMTE^XLFDT($P(PXRREDT,".")),!
D COL^PXRRPCR,PRINT,FTR^PXRRPCR
Q
PRINT ;_._.Set local varaibles and print report_._.
S PX=0 F S PX=$O(PXRRCLIN(PX)) Q:PX="" S PXRRCLIN=$P(PXRRCLIN(PX),U) D:PXRRQ
. I '$D(^TMP($J,"CL",1,PXRRCLIN))&('+$G(^TMP($J,PXRRCLIN,"TOT"))) W ?0,$E(PXRRCLIN,1,25) F I=32,41,53,62,69,74,79,95,106,117 W @"?I",0 I I=117 W !
. S PXRRTVCO=^TMP($J,"TVCO")
. S PXRRAV=$J((PXRRTVCO/PXRRCN),2,1)
. Q:'$D(^TMP($J,"CL",1,PXRRCLIN))&('+$G(^TMP($J,PXRRCLIN,"TOT")))
. S PXRRNEW=^TMP($J,PXRRCLIN,"NEW")
. S PXRREST=^TMP($J,PXRRCLIN,"ESTABLISHED")
. S PXRRCON=^TMP($J,PXRRCLIN,"CONSULT")
. S PXRRENT=^TMP($J,PXRRCLIN,"ENT")
. S PXRRTOT=^TMP($J,PXRRCLIN,"TOT")
. S PXRRNS=^TMP($J,PXRRCLIN,"NS")
. S PXRRCA=^TMP($J,PXRRCLIN,"CA")
. S PXRRUN=^TMP($J,PXRRCLIN,"UN")
. S PXRRNVCP=^TMP($J,PXRRCLIN,"NVCPT")
. S PXRROTH=^TMP($J,PXRRCLIN,"OTHER")
. S PXRROCP=^TMP($J,PXRRCLIN,"OTHER CPT")
. S PXRRPCT=$S($G(^TMP($J,PXRRCLIN,"TOT"))>0:(PXRRENT/PXRRTOT)*100,1:0)
. I $Y>(IOSL-5),IOST'?1"C-".E W @IOF,! D COL^PXRRPCR
. I $Y>(IOSL-5),IOST?1"C-".E S DIR(0)="E" D ^DIR K DIR S PXRRQ=Y W:Y @IOF,! D:PXRRQ COL^PXRRPCR
. W ?0,$E(PXRRCLIN,1,23),?32,PXRRNEW,?41,PXRREST,?53,PXRRCON,?62,PXRROTH,?69,PXRROCP,?74,PXRRNVCP,?79,PXRRENT,?95,PXRRUN,?106,PXRRNS,?117,PXRRCA,!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRRPCR1 1641 printed Dec 13, 2024@02:31:03 Page 2
PXRRPCR1 ;HIN/MjK - Clinic Specfic Workload Reports ;6/7/96
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
VIS ;_._._._._._._._._._._._.Clinic Workload_._._._._._._._._._._._.
+1 DO HDR^PXRRPCR
SET PXRRQ=1
IF $DATA(PXRSTPNM)
WRITE !?1,"Clinic Stop: ",PXRSTPNM,!
+2 WRITE ?1,"Encounter Date Range: ",$$FMTE^XLFDT($PIECE(PXRRBDT,"."))," through ",$$FMTE^XLFDT($PIECE(PXRREDT,".")),!
+3 DO COL^PXRRPCR
DO PRINT
DO FTR^PXRRPCR
+4 QUIT
PRINT ;_._.Set local varaibles and print report_._.
+1 SET PX=0
FOR
SET PX=$ORDER(PXRRCLIN(PX))
if PX=""
QUIT
SET PXRRCLIN=$PIECE(PXRRCLIN(PX),U)
if PXRRQ
Begin DoDot:1
+2 IF '$DATA(^TMP($JOB,"CL",1,PXRRCLIN))&('+$GET(^TMP($JOB,PXRRCLIN,"TOT")))
WRITE ?0,$EXTRACT(PXRRCLIN,1,25)
FOR I=32,41,53,62,69,74,79,95,106,117
WRITE @"?I",0
IF I=117
WRITE !
+3 SET PXRRTVCO=^TMP($JOB,"TVCO")
+4 SET PXRRAV=$JUSTIFY((PXRRTVCO/PXRRCN),2,1)
+5 if '$DATA(^TMP($JOB,"CL",1,PXRRCLIN))&('+$GET(^TMP($JOB,PXRRCLIN,"TOT")))
QUIT
+6 SET PXRRNEW=^TMP($JOB,PXRRCLIN,"NEW")
+7 SET PXRREST=^TMP($JOB,PXRRCLIN,"ESTABLISHED")
+8 SET PXRRCON=^TMP($JOB,PXRRCLIN,"CONSULT")
+9 SET PXRRENT=^TMP($JOB,PXRRCLIN,"ENT")
+10 SET PXRRTOT=^TMP($JOB,PXRRCLIN,"TOT")
+11 SET PXRRNS=^TMP($JOB,PXRRCLIN,"NS")
+12 SET PXRRCA=^TMP($JOB,PXRRCLIN,"CA")
+13 SET PXRRUN=^TMP($JOB,PXRRCLIN,"UN")
+14 SET PXRRNVCP=^TMP($JOB,PXRRCLIN,"NVCPT")
+15 SET PXRROTH=^TMP($JOB,PXRRCLIN,"OTHER")
+16 SET PXRROCP=^TMP($JOB,PXRRCLIN,"OTHER CPT")
+17 SET PXRRPCT=$SELECT($GET(^TMP($JOB,PXRRCLIN,"TOT"))>0:(PXRRENT/PXRRTOT)*100,1:0)
+18 IF $Y>(IOSL-5)
IF IOST'?1"C-".E
WRITE @IOF,!
DO COL^PXRRPCR
+19 IF $Y>(IOSL-5)
IF IOST?1"C-".E
SET DIR(0)="E"
DO ^DIR
KILL DIR
SET PXRRQ=Y
if Y
WRITE @IOF,!
if PXRRQ
DO COL^PXRRPCR
+20 WRITE ?0,$EXTRACT(PXRRCLIN,1,23),?32,PXRRNEW,?41,PXRREST,?53,PXRRCON,?62,PXRROTH,?69,PXRROCP,?74,PXRRNVCP,?79,PXRRENT,?95,PXRRUN,?106,PXRRNS,?117,PXRRCA,!
End DoDot:1
+21 QUIT
+22
