- 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
