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