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

PSJGMRA.m

Go to the documentation of this file.
  1. PSJGMRA ;BIR/MV - Retrieve and display Allergy data ;6 Jun 07 3:37 PM
  1. ;;5.0;INPATIENT MEDICATIONS;**181,270,260,252,257,281,347**;16 DEC 97;Build 6
  1. ;
  1. ; Reference to ^PS(50.605 is supported by DBIA 696.
  1. ; Reference to ^PSDRUG( is supported by DBIA 2192.
  1. ; Reference to ^PSODGAL1 supported by DBIA 5764.
  1. ; Reference to ^PS(50.7 supported by DBIA 2180.
  1. ; Reference to ^PS(55 supported by DBIA #2191.
  1. ;
  1. EN(DFN,PSJDD) ;
  1. ;DFN - Patient IEN
  1. ;PSJDD - ^PSDRUG IEN
  1. Q:'+$G(DFN)
  1. Q:'+$G(PSJDD)
  1. ;N PTR,GMRAING,PSJACK,PSJCLCNT,PSJFLG,PSJVACL,DIW,DIWF,DIWI,DIWL,DIWR,DIWT,DIWTC,DIWX,PSJNEW,X,Y,PSODRUG,PSODFN,PSJAOC
  1. N DIW,DIWF,DIWI,DIWL,DIWR,DIWT,DIWTC,DIWX,X,Y,PSODRUG,PSODFN,PSJAOC
  1. ;*347
  1. ;K DIC,PSJVACL,^TMP("GMRAOC",$J),^TMP($J,"PSJCLS"),^TMP("PSJDAI",$J)
  1. K DIC,^TMP($J,"PSJCLS"),^TMP("PSJDAI",$J)
  1. S DIC=50,DIC(0)="MQZV",X=PSJDD D ^DIC K DIC Q:Y=-1
  1. S PSODRUG("IEN")=PSJDD,PSODRUG("VA CLASS")=$P(Y(0),"^",2),PSODRUG("NAME")=$P(Y(0),"^")
  1. S:+$G(^PSDRUG(+Y,2)) PSODRUG("OI")=+$G(^(2)),PSODRUG("OIN")=$P(^PS(50.7,+$G(^(2)),0),"^")
  1. S PSODRUG("NDF")=$S($G(^PSDRUG(PSJDD,"ND"))]"":+^("ND")_"A"_$P(^("ND"),"^",3),1:0)
  1. ;changed in psj*5*260
  1. S PSJAOC=1,PSODFN=DFN D ^PSODGAL1
  1. S:$G(PSGORQF) VALMBCK="R"
  1. ;*347
  1. ;K ^TMP("GMRAOC",$J),^TMP($J,"PSJCLS")
  1. K ^TMP($J,"PSJCLS")
  1. Q
  1. INTERV(PSJRXREQ,PSJDD1) ;Prompt if user to log an intervention for significant interaction
  1. ;PSPRXREQ - intervention type
  1. ;PSJDD1 - Prospective drug name
  1. NEW DIR,DTOUT,DIRUT,DIROUT,DUOUT,Y,X
  1. I $G(PSGORQF)=1 Q
  1. S DIR(0)="SA^1:YES;0:NO",DIR("A")="Do you want to Intervene? ",DIR("B")=$S($G(PSJRXREQ)="ALLERGY":"YES",1:"NO")
  1. I $G(PSJDD1)]"" S DIR("A")="Do you want to Intervene with "_PSJDD1_"? "
  1. W ! D ^DIR
  1. S DIR("?",1)="Answer 'YES' if you DO want to enter an intervention for this medication,"
  1. S DIR("?")=" 'NO' if you DON'T want to enter an intervention for this medication,"
  1. I Y S PSGP=DFN D ^PSJRXI W !
  1. Q
  1. RINTERV(PSJRXREQ,PSJDD1) ;Prompt user to log an intervention for critical interaction
  1. ;PSPRXREQ - intervention type
  1. ;PSJDD1 - Prospective drug name
  1. NEW DIR,DTOUT,DIRUT,DIROUT,DUOUT,Y,X
  1. K PSGORQF
  1. S DIR(0)="SA^1:YES;0:NO",DIR("A")="Do you want to Continue? ",DIR("B")="NO"
  1. I $G(PSJDD1)]"" S DIR("A")="Do you want to Continue with "_PSJDD1_"? "
  1. S DIR("?",1)="Enter 'NO' if you wish to exit without continuing with the order,",DIR("?")="or 'YES' to continue with the order entry process."
  1. D ^DIR
  1. I 'Y S PSGORQF=1 S VALMBCK="R" Q
  1. I Y S PSGP=DFN D ^PSJRXI W !
  1. Q
  1. ;
  1. INST(PSJALCO) ;Find Institution for order
  1. N PSJALCR,PSJALCMC,PSJALCCL,PSJALCWA,PSJALCIV,PSJALCIN,PSJALCND,PSJALCP1,PSJALCP2
  1. I PSJALCO="" Q +$$SITE^VASITE(DT)
  1. S PSJALCR=""
  1. ;
  1. I PSJALCO["P" D G INSTM
  1. .S PSJALCCL=$P($G(^PS(53.1,+PSJALCO,"DSS")),"^") I PSJALCCL S PSJALCND=$G(^SC(PSJALCCL,0)) D Q
  1. ..S PSJALCIN=$P(PSJALCND,"^",4) I PSJALCIN S PSJALCR=PSJALCIN Q
  1. ..S PSJALCMC=$P(PSJALCND,"^",15)
  1. .S PSJALCIV=$P($G(^PS(53.1,+PSJALCO,8)),"^",8) I PSJALCIV D Q
  1. ..S PSJALCMC=$P($G(^PS(59.5,+PSJALCIV,0)),"^",4) Q
  1. .D INSTW
  1. ;
  1. I PSJALCO["U" S PSJALCP1=$P(PSJALCO,"U"),PSJALCP2=$P(PSJALCO,"U",2) D G INSTM
  1. .S PSJALCCL=$P($G(^PS(55,PSJALCP1,5,PSJALCP2,8)),"^") I PSJALCCL S PSJALCND=$G(^SC(PSJALCCL,0)) D Q
  1. ..S PSJALCIN=$P(PSJALCND,"^",4) I PSJALCIN S PSJALCR=PSJALCIN Q
  1. ..S PSJALCMC=$P(PSJALCND,"^",15)
  1. .D INSTW
  1. ;
  1. I PSJALCO["V" S PSJALCP1=$P(PSJALCO,"V"),PSJALCP2=$P(PSJALCO,"V",2) D G INSTM
  1. .S PSJALCCL=$P($G(^PS(55,PSJALCP1,"IV",PSJALCP2,"DSS")),"^") I PSJALCCL S PSJALCND=$G(^SC(PSJALCCL,0)) D Q
  1. ..S PSJALCIN=$P(PSJALCND,"^",4) I PSJALCIN S PSJALCR=PSJALCIN Q
  1. ..S PSJALCMC=$P(PSJALCND,"^",15)
  1. .S PSJALCIV=$P($G(^PS(55,PSJALCP1,"IV",PSJALCP2,2)),"^",2) I PSJALCIV D Q
  1. ..S PSJALCMC=$P($G(^PS(59.5,+PSJALCIV,0)),"^",4) Q
  1. .D INSTW
  1. ;
  1. Q +$$SITE^VASITE(DT)
  1. INSTM ;
  1. I PSJALCR Q PSJALCR
  1. I $G(PSJALCMC) Q +$$SITE^VASITE(DT,PSJALCMC)
  1. Q +$$SITE^VASITE(DT)
  1. ;
  1. INSTW ;
  1. S PSJALCWA=$$INSTV I PSJALCWA D
  1. .S PSJALCCL=$P($G(^DIC(42,+PSJALCWA,44)),"^") I PSJALCCL D Q:PSJALCR
  1. ..S PSJALCND=$G(^SC(PSJALCCL,0)) S PSJALCIN=$P(PSJALCND,"^",4) I PSJALCIN S PSJALCR=PSJALCIN Q
  1. ..S PSJALCMC=$P(PSJALCND,"^",15)
  1. .I '$G(PSJALCMC) S PSJALCMC=$P($G(^DIC(42,+PSJALCWA,0)),"^",11)
  1. Q
  1. ;
  1. INSTV() ;Retrieve Ward
  1. I '$G(DFN) Q 0
  1. N VAHOW,VAROOT,VAINDT,VAIN,VAERR
  1. D INP^VADPT
  1. Q +$G(VAIN(4))