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

APSPDUR.m

Go to the documentation of this file. 
  1. APSPDUR ;IHS/DSD/JCM/ENM - PHARMACY DUR;14-Sep-2010 12:41;SM
  1.  ;;7.0;IHS PHARMACY MODIFICATIONS;**1004,1008,1009**;Sep 23, 2004
  1.  ;THIS ROUTINE BUILDS THE PHARMACY DRUG UTILIZATION REVIEW GLOBAL
  1.  ;IT RUNS AND THEN CALLS APSPDUR1 TO DO THE ACUTAL PRINT OF LIST
  1.  ;
  1. EN ;EP
  1.  N APSPBD,APSPED,APSPBDF,APSPEDF,APSPDIV,APSPDRG,APSPDARY
  1.  N QFLG,DCNT
  1.  S (QFLG,DCNT)=0
  1.  W @IOF
  1.  W "Pharmacy DUR List ",!!
  1.  D ASKDATES^APSPUTIL(.APSPBD,.APSPED,.APSPQ,DT,DT)
  1.  Q:APSPQ
  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.  ;SELECT DIVISION
  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.  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='$$DIR^APSPUTIL("Y","Want to Select Another Drug","No",,.APSPQ)
  1.  .S:'QFLG QFLG=APSPQ
  1.  Q:'DCNT
  1.  D DEV
  1.  Q
  1. DEV ;EP
  1.  N XBRP,XBNS
  1.  S XBRP="OUT^APSPDUR"
  1.  S XBNS="APS*"
  1.  D ^XBDBQUE
  1.  Q
  1. OUT ;EP
  1.  U IO
  1.  K ^TMP($J)
  1.  D FIND(APSPBD,APSPED,"AD",.APSPDARY)
  1.  D FIND(APSPBD,APSPED,"ADP",.APSPDARY)
  1.  D EN^APSPDUR1
  1.  K ^TMP($J)
  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.  ..S DRG=$P(^PSRX(RXIEN,0),U,6)
  1.  ..Q:'DRG   ; Prescription must have a drug
  1.  ..Q:'$D(^PSDRUG(DRG,0))
  1.  ..Q:'$D(DARY(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.  ...Q:'$$DSPRDT(RXIEN,XREF,IEN)  ;check for release date
  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 0
  1.  ; Return release date for dispense
  1. DSPRDT(RX,TYP,SIEN) ;EP
  1.  Q $S($G(SIEN):+$P($G(^PSRX(RX,$S(TYP="ADP":"P",1:1),SIEN,0)),U,$S(TYP="ADP":19,1:18)),1:+$P(^PSRX(RX,2),U,13))
  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,NXT
  1.  S FTYPE=$S(XREF="ADP":"P",SIEN:"R",1:"F")
  1.  S NXT=$O(^TMP($J,"DATA",$C(1)),-1)
  1.  S NXT=NXT+1
  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 REMARK=$$GET1^DIQ($S(FTYPE="P":52.2,FTYPE="R":52.1,1:52),$S("PR"[FTYPE:SIEN_","_RX_",",1:RX),$S(FTYPE="P":.03,FTYPE="R":3,1:12))
  1.  S ^TMP($J,"DATA",NXT)=DIV_U_FDT_U_DRGNM_U_QTY_U_RXN_U_OPRV_U_REMARK
  1.  S ^TMP($J,"PSODUR",DIV,DFN,FDT,RX,NXT)=""
  1.  Q