APSPTDD1 ; IHS/DSD/ENM/CIA/PLS - TOTAL DRUGS DISPENSED PRINT ;14-Oct-2009 14:39;SM
;;7.0;IHS PHARMACY MODIFICATIONS;**1008**;Sep 23, 2004
; Modified - IHS/CIA/PLS - 02/16/04
; IHS/MSC/PLS - 01/05/09 - Routine updated
;THIS ROUTINE PRINTS THE PHARMACY DUR TOTAL # DRUGS DISPENSED LISTING
;IT IS CALLED BY APSPTDD
EN ;ENTRY POINT
N DRG,UNIT,DIV,APSPPG,APSPDT,APSPQ
N DN,I,X,PSOZDUR1,DX,DY
S (DX,DY)=1 X:$D(^%ZOSF("XY"))#2 ^("XY")
U IO
S (TOTAL,APSPPG)=0,APSPQ=""
;
S DRG="",UNIT="",DIV=0
I '$D(^TMP($J,"PSODUR")) D HDR
E F S DIV=$O(^TMP($J,"PSODUR",DIV)) Q:'DIV W @IOF D HDR,LOOP,DIVSUB Q:APSPQ
Q
LOOP F S DRG=$O(^TMP($J,"PSODUR",DIV,DRG)) Q:DRG=""!APSPQ D
.F S UNIT=$O(^TMP($J,"PSODUR",DIV,DRG,UNIT)) Q:UNIT=""!($D(DUOUT))!($D(DTOUT)) D DATE
Q
DIVSUB ;DIVISION SUB
Q:APSPQ
S APSPPG=0
I IOST["C-" D PAUS
Q
DATE ;
I $Y+4>IOSL,IOST["C-" D PAUS Q:APSPQ W @IOF D HDR
Q:APSPQ=1
I $Y+4>IOSL,IOST["P-" W @IOF D HDR
W !,DRG,?41,$J($P(^TMP($J,"PSODUR",DIV,DRG,UNIT),U,2),6),?55,UNIT,?70,$J(+^(UNIT),8)
Q
PAUS N DTOUT,DUOUT,DIR
S DIR("?")="Enter '^' to Halt or Press Return to continue"
S DIR(0)="FO",DIR("A")="Press Return to continue or '^' to Halt"
D ^DIR
I $D(DUOUT) S APSPQ=1
Q
HDR ;
S APSPPG=APSPPG+1
W !,$$GET1^DIQ(59,DIV,.01)," ""Total Drugs Dispensed"" List"
W ?73,"Page ",APSPPG
W !,"Date of Listing: "
W $$FMTE^XLFDT($$DT^XLFDT,"2ZD")
I APSPCLS D
.W ?31,"By: VA Drug Class - "_$$GET1^DIQ(50.605,APSPCLS,.01)
E W ?31,"By: Drug"
W !,"Outpatient Drugs dispensed from "
W APSPBDF," through ",APSPEDF,!
W "Total Number of Days = "_($$FMDIFF^XLFDT(APSPED,APSPBD)),!
S DN=0
I 'APSPCLS,APSPDALL D
.W "Drugs Selected ---->",?25,"All Drugs",!
E I 'APSPNOD D
.W "Drug(s) Selected ----->" F I=0:0 S DN=$O(APSPDARY(DN)) Q:'DN W ?25,$$GET1^DIQ(50,DN,.01),!
PRINT W !,?41,"Number",?55,"Type of Units",!
W "Drug Name",?41,"of Rx's",?55,"Dispensed",?70,"Total"
W ! F I=1:1:78 W "_"
I '$D(^TMP($J,"PSODUR")) W !!?20,"NO DRUGS FOUND !"
W !
Q
APSPTDD1 ; IHS/DSD/ENM/CIA/PLS - TOTAL DRUGS DISPENSED PRINT ;14-Oct-2009 14:39;SM
+1 ;;7.0;IHS PHARMACY MODIFICATIONS;**1008**;Sep 23, 2004
+2 ; Modified - IHS/CIA/PLS - 02/16/04
+3 ; IHS/MSC/PLS - 01/05/09 - Routine updated
+4 ;THIS ROUTINE PRINTS THE PHARMACY DUR TOTAL # DRUGS DISPENSED LISTING
+5 ;IT IS CALLED BY APSPTDD
EN ;ENTRY POINT
+1 NEW DRG,UNIT,DIV,APSPPG,APSPDT,APSPQ
+2 NEW DN,I,X,PSOZDUR1,DX,DY
+3 SET (DX,DY)=1
IF $DATA(^%ZOSF("XY"))#2
XECUTE ^("XY")
+4 USE IO
+5 SET (TOTAL,APSPPG)=0
SET APSPQ=""
+6 ;
+7 SET DRG=""
SET UNIT=""
SET DIV=0
+8 IF '$DATA(^TMP($JOB,"PSODUR"))
DO HDR
+9 IF '$TEST
FOR
SET DIV=$ORDER(^TMP($JOB,"PSODUR",DIV))
IF 'DIV
QUIT
WRITE @IOF
DO HDR
DO LOOP
DO DIVSUB
IF APSPQ
QUIT
+10 QUIT
LOOP FOR
SET DRG=$ORDER(^TMP($JOB,"PSODUR",DIV,DRG))
IF DRG=""!APSPQ
QUIT
Begin DoDot:1
+1 FOR
SET UNIT=$ORDER(^TMP($JOB,"PSODUR",DIV,DRG,UNIT))
IF UNIT=""!($DATA(DUOUT))!($DATA(DTOUT))
QUIT
DO DATE
End DoDot:1
+2 QUIT
DIVSUB ;DIVISION SUB
+1 IF APSPQ
QUIT
+2 SET APSPPG=0
+3 IF IOST["C-"
DO PAUS
+4 QUIT
DATE ;
+1 IF $Y+4>IOSL
IF IOST["C-"
DO PAUS
IF APSPQ
QUIT
WRITE @IOF
DO HDR
+2 IF APSPQ=1
QUIT
+3 IF $Y+4>IOSL
IF IOST["P-"
WRITE @IOF
DO HDR
+4 WRITE !,DRG,?41,$JUSTIFY($PIECE(^TMP($JOB,"PSODUR",DIV,DRG,UNIT),U,2),6),?55,UNIT,?70,$JUSTIFY(+^(UNIT),8)
+5 QUIT
PAUS NEW DTOUT,DUOUT,DIR
+1 SET DIR("?")="Enter '^' to Halt or Press Return to continue"
+2 SET DIR(0)="FO"
SET DIR("A")="Press Return to continue or '^' to Halt"
+3 DO ^DIR
+4 IF $DATA(DUOUT)
SET APSPQ=1
+5 QUIT
HDR ;
+1 SET APSPPG=APSPPG+1
+2 WRITE !,$$GET1^DIQ(59,DIV,.01)," ""Total Drugs Dispensed"" List"
+3 WRITE ?73,"Page ",APSPPG
+4 WRITE !,"Date of Listing: "
+5 WRITE $$FMTE^XLFDT($$DT^XLFDT,"2ZD")
+6 IF APSPCLS
Begin DoDot:1
+7 WRITE ?31,"By: VA Drug Class - "_$$GET1^DIQ(50.605,APSPCLS,.01)
End DoDot:1
+8 IF '$TEST
WRITE ?31,"By: Drug"
+9 WRITE !,"Outpatient Drugs dispensed from "
+10 WRITE APSPBDF," through ",APSPEDF,!
+11 WRITE "Total Number of Days = "_($$FMDIFF^XLFDT(APSPED,APSPBD)),!
+12 SET DN=0
+13 IF 'APSPCLS
IF APSPDALL
Begin DoDot:1
+14 WRITE "Drugs Selected ---->",?25,"All Drugs",!
End DoDot:1
+15 IF '$TEST
IF 'APSPNOD
Begin DoDot:1
+16 WRITE "Drug(s) Selected ----->"
FOR I=0:0
SET DN=$ORDER(APSPDARY(DN))
IF 'DN
QUIT
WRITE ?25,$$GET1^DIQ(50,DN,.01),!
End DoDot:1
PRINT WRITE !,?41,"Number",?55,"Type of Units",!
+1 WRITE "Drug Name",?41,"of Rx's",?55,"Dispensed",?70,"Total"
+2 WRITE !
FOR I=1:1:78
WRITE "_"
+3 IF '$DATA(^TMP($JOB,"PSODUR"))
WRITE !!?20,"NO DRUGS FOUND !"
+4 WRITE !
+5 QUIT
