Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: APSPTDD

APSPTDD.m

Go to the documentation of this file. 
  1. APSPTDD ;IHS/DSD/ENM/CIA/PLS - OUTPATIENT PHAR TOTAL DRUGS DISPENSED ;07-Jul-2010 15:55;SM
  1.  ;;7.0;IHS PHARMACY MODIFICATIONS;**1008,1009**;Sep 23, 2004
  1.  ; Modified - IHS/CIA/PLS - 02/16/04
  1.  ;            IHS/MSC/PLS - 01/02/08 - Routine updated
  1.  ;                          12/16/09 - Modified GETIEN1 to GETIEN for File 50
  1.  ;                          07/07/10 - Added S APSPDALL=0 when sorted by Drug Class
  1. EN ;EP
  1.  N APSPBD,APSPED,APSPBDF,APSPEDF,APSPDIV,APSPDRG,APSPQ
  1.  N APSPCLS,APSPDARY,APSPNOD,TCNT,APSPDALL,QFLG,TOTAL
  1.  N APSPSORT,DCNT
  1.  S (DCNT,APSPCLS)=0
  1.  W @IOF
  1.  W "Pharmacy Total Drugs Dispensed List ",!!
  1.  D ASKDATES^APSPUTIL(.APSPBD,.APSPED,.APSPQ,DT,DT)
  1.  Q:APSPQ
  1.  I APSPED<APSPBD S X=APSPED,APSPED=APSPBD,APSPBD=X
  1.  S APSPBDF=$P($TR($$FMTE^XLFDT(APSPBD,"5Z"),"@"," "),":",1,2)
  1.  S APSPEDF=$P($TR($$FMTE^XLFDT(APSPED,"5Z"),"@"," "),":",1,2)
  1.  S APSPBD=APSPBD-.01,APSPED=APSPED+.99
  1.  S APSPDIV=$$DIR^APSPUTIL("Y","Would you like all pharmacy divisions","Yes",,.APSPQ)
  1.  Q:APSPQ
  1.  I APSPDIV D
  1.  .S APSPDIV="*"
  1.  E  D  Q:APSPQ
  1.  .S APSPDIV=$$GETIEN^APSPUTIL(59,"Select Pharmacy Division: ",.APSPQ)
  1.  ; Sort by
  1.  S APSPSORT=$$DIR^APSPUTIL("S^1:VA Drug Class;2:Drug","Sort By",,.APSPQ)
  1.  I APSPSORT=1 D  Q:APSPCLS<0
  1.  .S APSPCLS=$$GETIEN1^APSPUTIL(50.605,"Select VA Drug Class: ",-1)
  1.  .S APSPDALL=0
  1.  E  D  Q:'APSPDALL&'DCNT
  1.  .S APSPDALL=$$DIRYN^APSPUTIL("Would you like all drugs","Yes","Enter 'Yes' or 'No'",.APSPQ)
  1.  .Q:APSPQ!APSPDALL
  1.  .F  D  Q:QFLG
  1.  ..S APSPDRG=$$GETIEN^APSPUTIL(50,"Select Drug Name: ",,"QM")
  1.  ..I APSPDRG<1 S QFLG=1 Q
  1.  ..S APSPDARY(APSPDRG)=""
  1.  ..S DCNT=DCNT+1
  1.  ..S QFLG='$$DIRYN^APSPUTIL("Want to Select Another Drug","No","Enter a 'Y' or 'YES' to include more drugs in your search",.APSPQ)
  1.  ..S:'QFLG QFLG=APSPQ
  1.  Q:APSPQ
  1.  S APSPNOD=$$DIRYN^APSPUTIL("Suppress printing drug names in header","Yes","Answer 'Yes' if you do not want the drug names to appear on each page",.APSPQ)
  1.  D DEV
  1.  Q
  1. DEV ;EP
  1.  N XBRP,XBNS
  1.  S XBRP="OUT^APSPTDD"
  1.  S XBNS="APS*"
  1.  D ^XBDBQUE
  1.  Q
  1. OUT ;EP
  1.  U IO
  1.  K ^TMP($J)
  1.  D:APSPCLS VAC  ; Build drug list
  1.  D FIND(APSPBD,APSPED,"AD",.APSPDARY)
  1.  D FIND(APSPBD,APSPED,"ADP",.APSPDARY)
  1.  D EN^APSPTDD1
  1.  K ^TMP($J)
  1.  Q
  1.  ;
  1. VAC ; Build drug list for selected VA Drug Class
  1.  N APSPDS
  1.  S APSPDS=0
  1.  F  S APSPDS=$O(^PSDRUG("VAC",APSPCLS,APSPDS)) Q:'APSPDS  D
  1.  .Q:'$D(^PS(50.605,APSPCLS))
  1.  .S APSPDARY(APSPDS)=""
  1.  Q
  1. FIND(SDT,EDT,XREF,DARY) ;EP
  1.  N RXIEN,ACTIEN,RTSDT,FILLDT,A0,FDTLP,IEN,DRG
  1.  S FDTLP=SDT-.01
  1.  F  S FDTLP=$O(^PSRX(XREF,FDTLP)) Q:'FDTLP!(FDTLP>EDT)  D
  1.  .S RXIEN=0
  1.  .F  S RXIEN=$O(^PSRX(XREF,FDTLP,RXIEN)) Q:'RXIEN  D
  1.  ..Q:$$CHKSTAT(RXIEN)          ; check prescription status
  1.  ..;Q:'$$DIVVRY(RXIEN,APSPDIV)  ;check division
  1.  ..S DRG=$P(^PSRX(RXIEN,0),U,6)
  1.  ..Q:'DRG   ; Prescription must have a drug
  1.  ..Q:'$D(^PSDRUG(DRG,0))
  1.  ..Q:'$$CHKDRG(DRG)
  1.  ..S IEN="" F  S IEN=$O(^PSRX(XREF,FDTLP,RXIEN,IEN)) Q:IEN=""  D
  1.  ...Q:'IEN&($$GET1^DIQ(52,RXIEN,32.1,"I"))  ; Quit if original fill anda return to stock date exists
  1.  ...Q:'$$DIVVRY(RXIEN,APSPDIV,XREF,IEN)  ;check division
  1.  ...D SET(FDTLP,RXIEN,XREF,IEN)
  1.  Q
  1.  ; Check status business rules
  1.  ; Input: RX - Prescription IEN
  1.  ; Output: 0 - Prescription status OK, 1- Failed check
  1. CHKSTAT(RX) ; EP
  1.  N STA
  1.  S STA=$P($G(^PSRX(RX,"STA")),U)
  1.  Q:STA=13 1  ; Deleted
  1.  Q:STA=5 1   ; Suspended
  1.  Q 0
  1.  ; Check prescription drug for report inclusion
  1.  ; Input: DRG - Prescription Drug
  1.  ; Output: 0 - Drug not included; 1 - Drug included
  1. CHKDRG(DRG) ;EP
  1.  Q:APSPDALL 1
  1.  Q ''$D(DARY(DRG))
  1.  ; Return boolean flag indicating valid pharmacy division
  1. DIVVRY(RX,DIV,TYP,SIEN) ;EP
  1.  Q:DIV="*" 1
  1.  Q $S($G(SIEN):DIV=+$P($G(^PSRX(RX,$S(TYP="ADP":"P",1:1),SIEN,0)),U,9),1:DIV=+$P(^PSRX(RX,2),U,9))
  1. SET(FDT,RX,XREF,SIEN) ;EP
  1.  N RXN,DFN,QTY,DRGNM,REMARK,OPRV,FTYPE,DIV,UNIT
  1.  S FTYPE=$S(XREF="ADP":"P",SIEN:"R",1:"F")
  1.  S RXN=$P(^PSRX(RX,0),U)  ; Prescription number
  1.  S DFN=$P(^PSRX(RX,0),U,2)  ; Patient IFN
  1.  S DIV=$$GET1^DIQ($S(FTYPE="P":52.2,FTYPE="R":52.1,1:52),$S("PR"[FTYPE:SIEN_","_RXIEN_",",1:RXIEN),$S(FTYPE="P":.09,FTYPE="R":8,1:20),"I")  ; Pharmacy Division IEN
  1.  S QTY=$$GET1^DIQ($S(FTYPE="P":52.2,FTYPE="R":52.1,1:52),$S("PR"[FTYPE:SIEN_","_RX_",",1:RX),$S(FTYPE="P":.04,FTYPE="R":1,1:7))
  1.  S DRGNM=$P(^PSDRUG(DRG,0),U) ;Drug Name
  1.  S OPRV=$$GET1^DIQ($S(FTYPE="P":52.2,FTYPE="R":52.1,1:52),$S("PR"[FTYPE:SIEN_","_RX_",",1:RX),$S(FTYPE="P":6,FTYPE="R":15,1:4),"I")
  1.  S UNIT=$$GET1^DIQ(50,DRG,14.5)
  1.  S:'$L(UNIT) UNIT="***"
  1.  I $D(^TMP($J,"PSODUR",DIV,DRGNM,UNIT)) D
  1.  .S ^TMP($J,"PSODUR",DIV,DRGNM,UNIT)=$P(^(UNIT),U)+QTY_U_($P(^(UNIT),U,2)+1)
  1.  E  S ^TMP($J,"PSODUR",DIV,DRGNM,UNIT)=QTY_U_1
  1.  Q