PSXCSHI1.m

PSXCSHI1 ;BIR/JMB-High Cost Rx Report-CONTINUED ;[ 04/08/97   2:06 PM ]

 ;;2.0;CMOP;**38**;11 Apr 97

PRINT ;Loops thru ^TMP global

 F PSXFAC=0:0 S PSXFAC=+$O(^TMP($J,PSXFAC)) Q:'PSXFAC!($G(PSXEXIT))  D  Q:$G(PSXEXIT)  D HD:($Y+4)>IOSL Q:$G(PSXEXIT)  W !!,"No. of Fills="_PSXCNT,?20,"'*' indicates a refill"

 .D HD S PSXCNT=0,PSXDG="" F  S PSXDG=$O(^TMP($J,PSXFAC,PSXDG)) Q:PSXDG=""!($G(PSXEXIT))  S PSXRXN="" F  S PSXRXN=$O(^TMP($J,PSXFAC,PSXDG,PSXRXN)) Q:PSXRXN=""!($G(PSXEXIT))  D

 ..F PSXIEN=0:0 S PSXIEN=+$O(^TMP($J,PSXFAC,PSXDG,PSXRXN,PSXIEN)) Q:'PSXIEN!($G(PSXEXIT))  D

 ...S PSXCNT=PSXCNT+1 D HD:($Y+4)>IOSL Q:$G(PSXEXIT)

 ...W !,$S($P(^TMP($J,PSXFAC,PSXDG,PSXRXN,PSXIEN),"^"):"* ",1:"  ")_PSXRXN,?15,PSXDG,?50,$J($P(^(PSXIEN),"^",2),4),?55,"x",?57,$J($P(^(PSXIEN),"^",3),6,3),?65,"=",?66,$J($P(^(PSXIEN),"^",4),7,2)

 Q

HD I PSXPG>1,$E(IOST)="C" S DIR(0)="FO",DIR("A")=" Press Return to Continue or ^ to Exit " D ^DIR K DIR I $G(DTOUT)!($G(DUOUT)) S PSXEXIT=1 Q

 S PSXFACR="ALL FACILITIES"

 ;I $G(PSXFAC)'="" N X,Y S X=PSXFAC,DIC=4,DIC(0)="MNZ" S:$D(^PSX(552,"D",X)) X=$E(X,2,99) D ^DIC K DIC S PSXFACR=Y(0,0) K X,Y ;****DOD L1

 I $G(PSXFAC)'="" N X,Y S X=PSXFAC,AGNCY="VASTANUM" S:$D(^PSX(552,"D",X)) X=$E(X,2,99),AGNCY="DMIS" S Y=$$IEN^XUMF(4,AGNCY,X),PSXFACR=$$GET1^DIQ(4,Y,.01)

 W:PSXPG>1!($E(IOST)="C") @IOF W !,"PRINTED: ",PSXPDT,?(72-$L(PSXPG)),"PAGE ",PSXPG S PSXPG=PSXPG+1

 W !!?(60-$L(PSXFACR)/2),"HIGH COST REPORT FOR ",PSXFACR

 W !?8,"FILLS THAT COST AT LEAST $",PSXMAX," -- FROM ",PSXBDTR," TO ",PSXEDTR

 W !!,"  RX #",?15,"DRUG",?51,"QTY",?59,"COST",?67,"TOTAL COST"

 W ! F PSXI=1:1:79 W "-"

 Q

PSXCSHI1  ;BIR/JMB-High Cost Rx Report-CONTINUED ;[ 04/08/97   2:06 PM ]

 +1       ;;2.0;CMOP;**38**;11 Apr 97

PRINT     ;Loops thru ^TMP global

 +1        FOR PSXFAC=0:0

               SET PSXFAC=+$ORDER(^TMP($JOB,PSXFAC))

               IF 'PSXFAC!($GET(PSXEXIT))

                   QUIT 

               Begin DoDot:1

 +2                DO HD

                   SET PSXCNT=0

                   SET PSXDG=""

                   FOR 

                       SET PSXDG=$ORDER(^TMP($JOB,PSXFAC,PSXDG))

                       IF PSXDG=""!($GET(PSXEXIT))

                           QUIT 

                       SET PSXRXN=""

                       FOR 

                           SET PSXRXN=$ORDER(^TMP($JOB,PSXFAC,PSXDG,PSXRXN))

                           IF PSXRXN=""!($GET(PSXEXIT))

                               QUIT 

                           Begin DoDot:2

 +3                            FOR PSXIEN=0:0

                                   SET PSXIEN=+$ORDER(^TMP($JOB,PSXFAC,PSXDG,PSXRXN,PSXIEN))

                                   IF 'PSXIEN!($GET(PSXEXIT))

                                       QUIT 

                                   Begin DoDot:3

 +4                                    SET PSXCNT=PSXCNT+1

                                       IF ($Y+4)>IOSL

                                           DO HD

                                       IF $GET(PSXEXIT)

                                           QUIT 

 +5                                    WRITE !,$SELECT($PIECE(^TMP($JOB,PSXFAC,PSXDG,PSXRXN,PSXIEN),"^"):"* ",1:"  ")_PSXRXN,?15,PSXDG,?50,$JUSTIFY($PIECE(^(PSXIEN),"^",2),4),?55,"x",?57,$JUSTIFY($PIECE(^(PSXIEN),"^",3),6,3),?65,"=",?66,$JUSTIFY($PIECE(^(

PSXIEN),"^",4),7,2)

                                   End DoDot:3

                           End DoDot:2

               End DoDot:1

               IF $GET(PSXEXIT)

                   QUIT 

               IF ($Y+4)>IOSL

                   DO HD

               IF $GET(PSXEXIT)

                   QUIT 

               WRITE !!,"No. of Fills="_PSXCNT,?20,"'*' indicates a refill"

 +6        QUIT 

HD         IF PSXPG>1

               IF $EXTRACT(IOST)="C"

                   SET DIR(0)="FO"

                   SET DIR("A")=" Press Return to Continue or ^ to Exit "

                   DO ^DIR

                   KILL DIR

                   IF $GET(DTOUT)!($GET(DUOUT))

                       SET PSXEXIT=1

                       QUIT 

 +1        SET PSXFACR="ALL FACILITIES"

 +2       ;I $G(PSXFAC)'="" N X,Y S X=PSXFAC,DIC=4,DIC(0)="MNZ" S:$D(^PSX(552,"D",X)) X=$E(X,2,99) D ^DIC K DIC S PSXFACR=Y(0,0) K X,Y ;****DOD L1

 +3        IF $GET(PSXFAC)'=""

               NEW X,Y

               SET X=PSXFAC

               SET AGNCY="VASTANUM"

               IF $DATA(^PSX(552,"D",X))

                   SET X=$EXTRACT(X,2,99)

                   SET AGNCY="DMIS"

               SET Y=$$IEN^XUMF(4,AGNCY,X)

               SET PSXFACR=$$GET1^DIQ(4,Y,.01)

 +4        IF PSXPG>1!($EXTRACT(IOST)="C")

               WRITE @IOF

           WRITE !,"PRINTED: ",PSXPDT,?(72-$LENGTH(PSXPG)),"PAGE ",PSXPG

           SET PSXPG=PSXPG+1

 +5        WRITE !!?(60-$LENGTH(PSXFACR)/2),"HIGH COST REPORT FOR ",PSXFACR

 +6        WRITE !?8,"FILLS THAT COST AT LEAST $",PSXMAX," -- FROM ",PSXBDTR," TO ",PSXEDTR

 +7        WRITE !!,"  RX #",?15,"DRUG",?51,"QTY",?59,"COST",?67,"TOTAL COST"

 +8        WRITE !

           FOR PSXI=1:1:79

               WRITE "-"

 +9        QUIT