PXRRPCR1.m

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

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