- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSXCSHI1 1635 printed Jan 18, 2025@02:45:02 Page 2
- 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