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

APSQSHOW.m

Go to the documentation of this file. 
  1. APSQSHOW ;IHS/ASDS/ENM/POC/CIA/PLS - SHOW RX THAT ARE OUTSIDE (ONLY IN V MED FILE AS EVENTS) ;26-Feb-2013 11:11;DU
  1.  ;;7.0;IHS PHARMACY MODIFICATIONS;**1006,1016**;Sep 23, 2004;Build 74
  1.  ; Modified IHS/MSC/MGH - 02/26/13 - Patch 1016 to exclude eRX meds from appearing
  1.  ;                        twice and to exclude DC'd meds
  1.  ;S EN ="SHOW" TO SHOW ENTRIES
  1.  ;S EN ="INVEN" TO PROCESS INTERVENTIONS
  1. EN(EN,NVFLG) ;EP - IHS/MSC/PLS - 11/16/07 - New EP
  1.  ; Modified - IHS/CIA/PLS - 01/14/04 - Added FMTLINE API
  1.  Q:'$D(EN)
  1.  S NVFLG=$G(NVFLG,0)
  1.  K ARR
  1.  S PSODFN=$G(PSODFN,$G(DFN,0))   ; IHS/CIA/PLS - 01/25/04
  1.  Q:'PSODFN
  1.  S X1=DT,X2=-365 D C^%DTC S ARREDATE=X
  1.  ;S ERR=$$MEDS^APSPORXF(PSODFN,"ARR(",ARREDATE,DT,"E")
  1.  ;Q:ERR
  1.  D FAST
  1.  D ALL
  1.  I EN="SHOW" I $Y+5>IOSL K DIR S DIR(0)="E" D ^DIR K DIR S:$D(DUOUT) PSOQFLG=1 K DIRUT,DTOUT,DUOUT,DIROUT
  1.  D:EN="SHOW" CLEAN1
  1.  ;WE'LL CLEAN UP FROM PSODSPL
  1.  K EN
  1.  Q
  1. ALL S ARRNUM=0 F  Q:$G(ARRNUM)=""  S ARRNUM=$O(ARR(ARRNUM)) Q:(ARRNUM="")!($G(PSOQFLG)=1)  D
  1.  .S ARRNODE=ARR(ARRNUM)
  1.  .S ARRDYS=$P(ARRNODE,U,9)
  1.  .S ARRISS=$P(ARRNODE,U,3)
  1.  .S X1=ARRISS,X2=$S(ARRDYS*2>60:ARRDYS*2,1:60) ;AT LEAST 60 DAYS OR TIMES 2 OF DYS SUPPLY
  1.  .D C^%DTC Q:DT>X
  1.  .S ARRDRIEN=$P(ARRNODE,U,4)
  1.  .S ARRQTY=$P(ARRNODE,U,8)
  1.  .S ARRDRUG=$S($P(ARRNODE,U,6)]"":"%"_$P(ARRNODE,U,6),1:$P(ARRNODE,U,5))
  1.  .S ARRDRUG=$E(ARRDRUG,1,20)_" ["_$E($P(ARRNODE,U,11),1,10)_"]"
  1.  .S ARRNDF=$S($G(^PSDRUG(ARRDRIEN,"ND"))]"":+^("ND")_"A"_$P(^("ND"),"^",3),1:0)
  1.  .S ARRCLASS=$P(^PSDRUG(ARRDRIEN,0),U,2)
  1.  .D @EN
  1.  .Q
  1.  Q
  1. SHOW W !
  1.  W ?1,"OUTSIDE RX"
  1.  W ?13," ",$E(ARRDRUG,1,30),?49,$J(ARRQTY,3)
  1.  W ?53,$E(ARRISS,4,5),"-",$E(ARRISS,6,7),?74,$J(ARRDYS,3)
  1.  ;I $Y+2>IOSL K DIR S DIR(0)="E" D ^DIR K DIR S:$D(DUOUT) PSOQFLG=1 K DIRUT,DTOUT,DUOUT,DIROUT
  1.  Q
  1.  ;
  1. INVEN ;
  1.  S AZOSD(ARRDRUG)="^99^^^"_ARRCLASS_"^^"_ARRNDF_"^"_ARRDYS
  1.  Q
  1. CLEAN1 K EN
  1. CLEAN D EN^XBVK("ARR")
  1.  Q
  1. FAST ;FASTER LOOKUP HARDCODED
  1.  ;K ARRNUM
  1.  ;REMEMBER THE DATES ARE IN REVERSE ORDER
  1.  S ARRDATST=9999999-ARREDATE,ARRDA=0,ARRREVDT="" ;ARRDATST=END DATE
  1.  F  S ARRREVDT=$O(^AUPNVMED("AA",PSODFN,ARRREVDT)) Q:ARRREVDT=""!(ARRREVDT=ARRDATST)  F  S ARRDA=$O(^AUPNVMED("AA",PSODFN,ARRREVDT,ARRDA)) Q:ARRDA=""  D
  1.  .S ARRSTR=$G(^AUPNVMED(ARRDA,0))
  1.  .I $G(NVFLG) Q:$P($G(^AUPNVMED(ARRDA,11)),U,8)  ; Prevent Non-VA Meds from appearing twice.
  1.  .Q:'ARRSTR
  1.  .S ARRVISIT=$P(ARRSTR,"^",3)
  1.  .Q:'ARRVISIT
  1.  .Q:$P($G(^AUPNVMED(ARRDA,0)),U,8)   ;IHS/MSC/MGH P1016 Don't output discontinued meds
  1.  .Q:$P($G(^AUPNVSIT(ARRVISIT,0)),"^",7)'="E"  ;GOT TO BE EVENT
  1.  .S ARRDAY=+$G(^AUPNVSIT(ARRVISIT,0)),ARRDAY=$P(ARRDAY,".",1) ;DATE
  1.  .Q:'ARRDAY
  1.  .;IHS/MSC/MGH P1016 don't output eRX meds
  1.  .S ARRERX=$P($G(^AUPNVMED(ARRDA,11)),U,2)
  1.  .Q:$E(ARRERX,1,1)="X"
  1.  .;THESE LINES UNCOMMENTED IF WANT TO LIMIT DRUGS SHOWING BY DAYS SUPPLY
  1.  .S ARRDAY1=$P(ARRSTR,"^",7) ;DAYS SUPPLY
  1.  .I ARRDAY1 S ARRDAY1=2*ARRDAY1,X1=ARRDAY,X2=ARRDAY1 D C^%DTC Q:DT>X
  1.  .;END OF SUBROUTINE THAT LIMITS SHOWING DRUGS TO 2 X DAYS SUPPLY IHS/OKCAO/POC 6/25/98
  1.  .;S ARRDIEN=$P(ARRSTR,"^",3)
  1.  .S ARRDIEN=+ARRSTR
  1.  .Q:'ARRDIEN
  1.  .S ARRDRUG=$P($G(^PSDRUG(ARRDIEN,0)),"^",1)
  1.  .Q:ARRDRUG=""
  1.  .I $P(ARRSTR,"^",4)]"" S ARRDRUG="%"_$P(ARRSTR,"^",4) ;IF NON TABLE DRUG
  1.  .S ARROUTLC=$P($G(^AUPNVSIT(ARRVISIT,21)),"^",1)
  1.  .S ARRNUM=$G(ARRNUM)+1
  1.  .S ARR(ARRNUM)=ARRDA_"^"_ARRVISIT_"^"_ARRDAY_"^"_ARRDIEN_"^"_ARRDRUG_"^^"_$P(ARRSTR,"^",5)_"^"_$P(ARRSTR,"^",6)_"^"_$P(ARRSTR,"^",7)_"^^"_ARROUTLC
  1.  .Q
  1.  Q
  1.  ; Returns formatted list of outside Rxs in data
  1. FMTLINES(DATA,CNT,NVFLG) ; EP  IHS/CIA/PLS - 01/15/04
  1.  N ARR,ARRDA,ARRDATST,ARRDAY,ARRDAY1,ARRDIEN,ARRDRUG,ARREDATE
  1.  N ARRNUM,ARROUTLC,ARRREVDT,ARRNODE,ARRDYS,ARRISS,X1,X2,ARRQTY
  1.  N ARRSTR,ARRVISIT,ARRNDF,ARRCLASS,ARRDRIEN,NODE
  1.  S NVFLG=$G(NVFLG,0)
  1.  S PSODFN=$G(PSODFN,$G(DFN,0))   ; IHS/CIA/PLS - 01/25/04
  1.  Q:'PSODFN
  1.  S ARREDATE=$$FMADD^XLFDT(DT,-365)
  1.  D FAST
  1.  S ARRNUM=0 F  Q:$G(ARRNUM)=""  S ARRNUM=$O(ARR(ARRNUM)) Q:'ARRNUM  D
  1.  .S ARRNODE=ARR(ARRNUM)
  1.  .S ARRDYS=$P(ARRNODE,U,9)
  1.  .S ARRISS=$P(ARRNODE,U,3)
  1.  .Q:DT>$$FMADD^XLFDT(ARRISS,$S(ARRDYS*2>60:ARRDYS*2,1:60))   ; At least 60 days or 2x days supply
  1.  .S ARRDRIEN=$P(ARRNODE,U,4)
  1.  .S ARRQTY=$P(ARRNODE,U,8)
  1.  .S ARRDRUG=$S($P(ARRNODE,U,6)]"":"%"_$P(ARRNODE,U,6),1:$P(ARRNODE,U,5))
  1.  .S ARRDRUG=$E(ARRDRUG,1,20)_" ["_$E($P(ARRNODE,U,11),1,10)_"]"
  1.  .S ARRNDF=$S($G(^PSDRUG(ARRDRIEN,"ND"))]"":+^("ND")_"A"_$P(^("ND"),"^",3),1:0)
  1.  .S ARRCLASS=$P(^PSDRUG(ARRDRIEN,0),U,2)
  1.  .S CNT=CNT+1
  1.  .S NODE="OUTSIDE RX       "_$E(ARRDRUG,1,30)_"         "_$J(ARRQTY,3)_"    "_$E(ARRISS,4,5)
  1.  .S NODE=NODE_"-"_$E(ARRISS,6,7)_"          "_$J(ARRDYS,4)
  1.  .S @DATA@(CNT,0)=NODE
  1.  Q