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

APSPMULT.m

Go to the documentation of this file. 
  1. APSPMULT ;IHS/MSC/JDS - Multidivisional drug lookup support;07-Mar-2011 15:06;SM
  1.  ;;7.0;IHS PHARMACY MODIFICATION;**1009,1010**;DEC 11, 2003
  1.  ;
  1. PRINT ;EP
  1.  N PDIV
  1.  S DIC="^PS(59,",DIC(0)="MEQA" D ^DIC Q:Y'>0  S PDIV=+Y
  1.  S DIS(1)="I $$PRTSCRN^APSPMULT(D0,PDIV)"
  1.  S DIC="^PSDRUG(",FLDS="[APSPMULTI]",BY=".01",DIPA("NUM")=1 D EN1^DIP
  1.  Q
  1. SCREEN(IEN,NEWSITE,ALWAYS) ;EP
  1.  N DICR,DIVAL,PAT
  1.  I '$G(ALWAYS) I $P($G(XQY0),U)="" Q 1   ;only for OR and PS options.
  1.  ;S DFN=$G(DFN,$S($T(GETVAR^CIAVMEVT)]"":$$GETVAR^CIAVMEVT("PATIENT.ID.MRN",,"CONTEXT.PATIENT"),1:""))
  1.  S PAT=$S($G(PSODFN):PSODFN,$G(DFN):DFN,$G(CIA("UID"))&($T(GETVAR^CIAVMEVT)]""):$$GETVAR^CIAVMEVT("PATIENT.ID.MRN",,"CONTEXT.PATIENT"),1:0)
  1.  I $G(APSPMULT) Q 1  ;dont screen.
  1.  I '$G(ALWAYS) I '$$GET^XPAR("ALL","APSP MULTI DRUG SCREEN OPTION",$P(XQY0,U)) Q 1
  1.  N SITE I $G(PSOSITE) S SITE=PSOSITE
  1.  I $G(NEWSITE) S SITE=NEWSITE
  1.  I '$G(SITE) S SITE=$O(^PS(59,"D",+$G(DUZ(2)),"")) Q:'SITE 1
  1.  I PAT,$P($G(^APSPCTRL(+$G(SITE,1),3)),U,21) I '$$ELIG(PAT,$P($G(^PSDRUG(IEN,9999999)),U,7)) Q 0  ;not on cost plan
  1.  I '$$GET^XPAR("ALL","APSP RESTRICT DRUG BY OPT SITE") Q 1
  1.  I '$O(^PSDRUG(IEN,9999999.41,0)) Q 1
  1.  I $D(^PSDRUG(IEN,9999999.41,SITE)) Q 1
  1.  Q 0
  1.  ; Screen used for Division Report
  1. PRTSCRN(DRUG,PDIV) ;EP
  1.  Q ''$D(^PSDRUG(DRUG,9999999.41,PDIV))
  1. ELIG(DFN,DRUGELIG) ;
  1.  ;is this patient eligible for alternate cost plan.
  1.  N ELIG
  1.  I DRUGELIG="" Q 1
  1.  S ELIG=$P($G(^AUPNPAT(+$G(DFN),11)),U,12) I ELIG="" Q 0
  1.  I "I"=ELIG,DRUGELIG=1 Q 1
  1.  I (DRUGELIG=0)&("DCP"[ELIG) Q 1
  1.  Q 0
  1. ALL ;postinit make all drugs alternate care plan
  1.  K ^TMP("MSCPS",$J)
  1.  F I=0:0 S I=$O(^PSDRUG(I)) Q:'I  S ^TMP("MSCPS",$J,50,I_",",9999999.07)=1
  1.  D FILE^DIE("","^TMP(""MSCPS"",$J)")
  1.  K ^TMP("MSCPS",$J)
  1.  Q
  1. TRANSFER ;Transfer from one division to other
  1.  N DIC,TO,FROM,I,DINUM,%,CNT
  1.  S DIC="^PS(59,",DIC(0)="MEQA",DIC("A")="Select FROM-> Site: " D ^DIC Q:Y'>0  S FROM=+Y
  1.  S DIC="^PS(59,",DIC(0)="MEQA",DIC("A")="Select ->TO Site: ",DIC("S")="I FROM'=+Y" D ^DIC Q:Y'>0
  1.  S TO=+Y,CNT=0
  1.  W !,"Ok to continue" D YN^DICN Q:%'=1
  1.  F I=0:0 S I=$O(^PSDRUG(I)) Q:'I  D
  1.  .I '$D(^PSDRUG(I,9999999.41,FROM)) Q
  1.  .I $D(^PSDRUG(I,9999999.41,TO)) Q
  1.  .S DIC="^PSDRUG("_I_",9999999.41,",DIC(0)="LMN",X=TO,DA(1)=I,DINUM=TO N I D FILE^DICN S CNT=CNT+1
  1.  W !,CNT," Drugs put in outpatient site"
  1.  Q
  1. PRATL(TRUE) ;ALTERNATE LIST
  1.  N DHD
  1.  S DIS(1)="I $P($G(^PSDRUG(+Y,9999999)),U,7)"_$S(TRUE:"=0",1:"=1")
  1.  S DHD="Drugs Designated for Patients with "_$S(TRUE:"",1:"In")_"Eligible Status"
  1.  S DIC="^PSDRUG(",FLDS="[APSPALT]",BY=".01",DIPA("NUM")=1,L=0 D EN1^DIP
  1.  Q
  1. REPT ;
  1.  N DHD
  1.  S %DT="AE",%DT("A")="Enter Report Month: " D ^%DT Q:Y'>0  S STDT=$E(Y,1,5)_"00",ENDT=$E(Y,1,5)_32
  1.  S X=STDT X ^DD("DD") S MONTH=Y
  1.  S DIR(0)="S^0:Eligible;1:InEligible",DIR("A")="Select Eligible/Ineligible" D ^DIR Q:X[U  S ELIG=+$G(Y)
  1.  S DIC="^PSDRUG(",BY="@NUMBER",(FR,TO)=$O(^PSDRUG(0)),FLDS="D DEQUE^APSPMULT",DHD="[APSPMULTI HDR]" D EN1^DIP
  1.  Q
  1. DEQUE D PRINTM
  1.  D PRINT1
  1.  Q
  1. PRINTM ;
  1.  ;go through log for date range
  1.  K ^TMP("PSMULTI",$J)
  1.  F I=STDT:0 S I=$O(^PS(55,"AUDS",I)) Q:('I)!(I>ENDT)  F J=0:0 S J=$O(^PS(55,"AUDS",I,J)) Q:'J   F K=0:0 S K=$O(^PS(55,"AUDS",I,J,K)) Q:'K  D
  1.  .S ZERO=$G(^PS(55,I,5,J,0)),OI=+$G(^(.2)),END=$P($G(^(2)),U,4),DATE=$P(ZERO,U,14) I END<ENDT D
  1.  ..N T F L=0:0 S L=$O(^PS(55,J,5,K,11,L)) Q:'L  S ZERO=$G(^(L,0)) D
  1.  ...I (ZERO<STDT)!(ZERO>ENDT) Q
  1.  ...S DRIEN=+$P(ZERO,U,2) Q:($P($G(^PSDRUG(+DRIEN,9999999)),U,7)'=ELIG)  S DRUG=$P($G(^PSDRUG(DRIEN,0)),U),^TMP("PSMULTI",$J,"B",DRUG,DRIEN)=""
  1.  ...S T=$G(^TMP("PSMULTI",$J,DRIEN))
  1.  ...I '$G(T(DRIEN,K)) S $P(^(DRIEN),U,1)=T+1,T(DRIEN,K)=1
  1.  ...S $P(^(DRIEN),U,2)=$P(T,U,2)+$P(ZERO,U,3)
  1.  ;now go through prescriptions
  1.  F I=STDT:0 S I=$O(^PSRX("AC",I)) Q:(('I)!(I>ENDT))  F J=0:0 S J=$O(^PSRX("AC",I,J)) Q:'J  D
  1.  .S ZERO=$G(^PSRX(J,0)),TWO=$G(^(2)) Q:ZERO=""
  1.  .S DRIEN=$P(ZERO,U,6) Q:($P($G(^PSDRUG(+DRIEN,9999999)),U,7)'=ELIG)
  1.  .S D=$P(TWO,U,5) Q:'D  I D<STDT!(D>ENDT) Q
  1.  .S DRUG=$P($G(^PSDRUG(DRIEN,0)),U),^TMP("PSMULTI",$J,"B",DRUG,DRIEN)=""
  1.  .S T=$G(^TMP("PSMULTI",$J,DRIEN)),^(DRIEN)=(1+T)_U_($P(T,U,2)+$P(ZERO,U,7))
  1.  Q
  1. PRINT1 ;
  1.  S A=""
  1.  F  S A=$O(^TMP("PSMULTI",$J,"B",A)) Q:A=""  F I=0:0 S I=$O(^TMP("PSMULTI",$J,"B",A,I)) Q:'I  D
  1.  .D N^DIO2 W:$X ! W A,?42,$J($P($G(^TMP("PSMULTI",$J,I)),U),6),?58,$J($P($G(^(I)),U,2),6)
  1.  .;D N^DIO2
  1.  I '$L($O(^TMP("PSMULTI",$J,"B",""))) D N^DIO2 W !,"No Activity During this Period",!
  1.  Q
  1. ADDIV ;Add/Remove from Division
  1.  N DIC S DIC="^PS(59,",DIC(0)="MEQA" D ^DIC Q:Y'>0  S DIV=+Y
  1.  N DIC S DIC="^PSDRUG(",DIC(0)="MEQA",DIC("W")="D W^APSPMULT" D ^DIC Q:Y'>0
  1.  I $D(^PSDRUG(+Y,9999999.41,DIV)) W !,"This Drug is already in this division",!,"Do you wish to Delete"
  1.  E  W !,"Add this Drug to the Divsion"
  1.  D YN^DICN Q:%=-1  G ADDIV:%'=1
  1.  S (DIC,DIK)="^PSDRUG("_(+Y)_",9999999.41,",DA=DIV,DA(1)=+Y
  1.  I '$D(^PSDRUG(+Y,9999999.41,DIV)) D  G ADDIV
  1.  .I '$D(^PSDRUG(+Y,9999999.41,0)) S ^(0)="50.999999941PA^^"
  1.  .S (DINUM,X)=DIV S DIC(0)="L" D FILE^DICN
  1.  D ^DIK
  1.  G ADDIV
  1. W ;
  1.  N I F I=0:0 S I=$O(^PSDRUG(+Y,9999999.41,I)) Q:'I  W:$X>45 ! W ?45," ",$P($G(^PS(59,+I,0)),U)
  1.  Q
  1. EDITP ;Edit the parameter
  1.  N MSC,DICR,DIVAL,DIR,X,Y
  1.  S MSC=$$GET^XPAR("ALL","APSP RESTRICT DRUG BY OPT SITE"),MSC=$S(MSC:"Yes",1:"No")
  1.  S DIR="Restrict Drug Selection Based on Outpatient Site"
  1.  S DIR(0)="Y^",DIR("B")=MSC
  1.  S DIR("A")="Restrict Drug Selection Based on Outpatient Site"
  1.  D ^DIR Q:$G(DIRUT)
  1.  D PUT^XPAR("SYS","APSP RESTRICT DRUG BY OPT SITE",1,Y)
  1.  Q
  1. SITE() ; return outpatient site
  1.  N SITE
  1.  I $G(PSOSITE) Q PSOSITE
  1.  S SITE=$O(^PS(59,"D",+$G(DUZ(2)),"")) Q $S(SITE:SITE,1:+$O(^APSPCTRL(0)))
  1.  Q
  1. OI(OI,DFN) ;screen orderable item
  1.  N DRUG,POI
  1.  S POI=$P($G(^ORD(101.43,+OI,0)),U,2)
  1.  I POI'[";99PSP" Q 1
  1.  ;check if order has specific drug
  1.  I $G(^OR(100,+$G(IFN),0)) D  I DRUG Q $$SCREEN(DRUG,,1)
  1.  .S DRUG=0 N I F I=0:0 S I=$O(^OR(100,+$G(IFN),4.5,I)) Q:'I  I $P($G(^(I,0)),U,4)="DRUG" S DRUG=$G(^(1)) Q
  1.  F DRUG=0:0 S DRUG=$O(^PSDRUG("ASP",+$G(POI),DRUG)) Q:'DRUG  I $$SCREEN(DRUG,,1) Q
  1.  I 'DRUG Q 0
  1.  Q 1
  1. QUICK(IEN) ;EP-validate quick order
  1.  N OI,DRUG
  1.  S DRUG=+$O(^ORD(101.41,"B","OR GTX DISPENSE DRUG",0))
  1.  S OI=+$O(^ORD(101.41,"B","OR GTX ORDERABLE ITEM",0))
  1.  S DRUG=+$O(^ORD(101.41,IEN,6,"D",DRUG,0)) I DRUG D  I DRUG Q $$SCREEN(DRUG,,1)
  1.  .S DRUG=+$G(^ORD(101.41,IEN,6,DRUG,1))
  1.  S OI=+$O(^ORD(101.41,IEN,6,"D",OI,0)),OI=+$G(^ORD(101.41,IEN,6,+OI,1))
  1.  Q $$OI(OI,$G(DFN))