- PSODGAL1 ;BIR/LC,SAB - enhanced DRUG ALLERGY REACTION CHECKING ;12/09/07 02:22
- ;;7.0;OUTPATIENT PHARMACY;**251,401,390,424,429,411,500**;DEC 1997;Build 9
- ;External reference to $$ORCHK2^GMRAOR supported by DBIA 2378
- ;External reference to ^PS(50.605 supported by DBIA 696
- ;External reference to ^XUSEC("PSORPH" supported by DBIA 10076
- ;External reference to GETOC4^OROCAPI1 supported by DBIA 5729
- ;External reference to ^PS(55 supported by DBIA 2228
- ;External reference to ^PS(53.1 supported by DBIA 5793
- ;External reference to ^PSJRXI supported by DBIA 6076
- ;External reference to SIG^XUSESIG supported by DBIA 10050
- ;External reference to $$FINDC^PSJDGAL2 supportedby DBIA 6140
- ;
- EN ; Called from both inpatient and outpatient pharmacy
- N PSOACK,DFN,PSODAL,RXN,LPTR,PSOSEVT,PSOSEVT1,NDF,PSOSYMS,PSOINGRE,PSOSORT,PSOGIEN,PSODGCL,PSODGCL1,I,II,PSOADA,PSOADAT,PSOASEV,PSOASITE,PSODRCL1,PSODRCL
- N PSOINGR,PSOGMRA,PSOGMRA2,PSOIADAT,PSOLCLAS,PSOLOC,PSOOINGR,PSOSEV,PSOSNAM,PTR,TYP,ZPOP,ZPOP2,ZSITE,ZZSITE,PSOCAGNT,PSORXORD
- K ^TMP($J,"PSODRCLS"),DSPLQ,PSOMDC,ZGMRA,GMRAING,GMRADRCL,GMRAREAC,PSOALGYF,PSOASORT,GMRARSLT
- S DFN=PSODFN
- S (NDF,TYP,PTR,PSOALGYF)=""
- I $D(PSODRUG("NDF")),PSODRUG("NDF")'=0 S NDF=$P(PSODRUG("NDF"),"A"),TYP=$P(PSODRUG("NDF"),"A",2),PTR=$S(NDF=0:"",1:NDF)_"."_TYP
- S $P(PTR,".",3)=PSODRUG("IEN")
- ;
- CHK ;matched to ndf
- S:'$G(PSJALGCT) PSJALGCT=1 ;counter for inpatient; OP will always be 1
- K ZMED,ZMEDLCL S PSOACK=$$ORCHK2^GMRAOR(DFN,"DR",PTR,"","GMRARSLT") D:+$G(PSOACK)>0
- .D DSPLY Q:$G(PSORX("DFLG"))!($G(PSGORQF))
- .Q:$D(^XUSEC("PSORPH",DUZ))!($G(PSODGCK))
- .I +$G(PSOACK)=1 D
- ..N ZMSG,ZLOCAL,ZINGREDS,ZI,ZINGRED
- ..S ^TMP("PSODAI",$J,0)=1,(PSOSEV,PSOLOC,PSODRG)=""
- ..S ZMSG="" F S ZMSG=$O(GMRARSLT(ZMSG)) Q:'ZMSG D
- ...S PSOGIEN=$$GMSGPTR(ZMSG)
- ...Q:PSOGIEN=""
- ...S ZLOCAL=$S($P(GMRARSLT(ZMSG,PSOGIEN),U,2)="L":" (local)",1:" (remote)")
- ...S ZINGREDS=$G(GMRARSLT(ZMSG,"MESSAGE","OFFENDERS","ING"))
- ...Q:ZINGREDS=""
- ...S:$E(ZINGREDS,1)="~" ZINGREDS=$E(ZINGREDS,2,9999)
- ...F ZI=1:1:$L(ZINGREDS,"~") S ZINGRED=$P(ZINGREDS,"~",ZI) Q:ZINGRED="" D
- ....S ^TMP("PSODAI",$J,ZI,0)=ZINGRED_ZLOCAL
- ....Q
- Q:$G(PSORX("DFLG"))!($G(PSGORQF))
- S NDF=$P(PSODRUG("NDF"),"A")
- I +$G(PSOACK)>0!$G(^TMP($J,"PSODRCLS",0)) D
- .I '$D(^XUSEC("PSORPH",DUZ)),'$D(PSOMDC) K DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to continue" D ^DIR K DIR,DUOUT,DIRUT Q
- .I $D(PSJDGCK)!$D(PSODGCK) K DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to continue" D ^DIR K DIR,DUOUT,DIRUT W @IOF Q
- .S DIR("?",1)="Answer 'YES' if you DO want to enter a intervention for this medication,",DIR("?")=" 'NO' if you DON'T want to enter a intervention for this medication,"
- .S DIR(0)="SA^1:YES;0:NO",DIR("A")="Do you want to Intervene? ",DIR("B")="YES" D ^DIR I '$G(PSJAOC) W !
- .I ($D(DTOUT))!($D(DUOUT)) S:'$G(PSJAOC) (PSODLQT,PSORX("DFLG"))=1 S:$G(PSJAOC) PSGORQF=1 Q
- .I 'Y D:$G(PSOSEVT1("S"))=1 Q
- ..S:$G(PSJAOC) PSGORQF=1
- ..S:'$G(PSJAOC) (PSORX("DFLG"),PSOQUIT)=1
- ..W !!,"With a SEVERE reaction, an intervention is required!",! S VALMBCK="R"
- ..I $G(PSGCOPY)=1!($G(PSIVCOPY)=1) W !,"Order not copied!",! S PSJCOFLG=1 ;set flag if COPY to not repeat this message in PSGOD
- ..I $G(PSJREN)=1 W !,"No changes made to this order!",! S PSJRNFLG=1 ;set flag if RENEW to not repeat this message in PSGOEE
- ..I '$G(PSOSPRNW) K DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to continue" D ^DIR
- ..S:$G(PSOSPRNW) PSORENW("DFLG")=1,PSORX("DFLG")=0,PSOQUIT=1
- ..I $D(DTOUT)!($D(DUOUT)) D K DIR,DUOUT,DIRUT W !
- ...I $G(PSJAOC) S PSGORQF=1 Q ;inpatient
- ...S (PSODLQT,PSOQUIT,PSORX("DFLG"))=1
- .D CRI:$G(PSOSEVT1("S"))=1
- .Q:$G(PSORX("DFLG"))!($G(PSGORQF))
- .I $G(PSJAOC) S PSJDAL=1 D ^PSJRXI I $G(PSJDAL("DA")) S $P(^TMP("PSODAOC",$J,"ALLERGY",PSJALGCT,"INTERVENTION"),"^")=PSJDAL("DA") K PSJDAL("DA")
- .I '$G(PSJAOC) S PSODAL=1 D ^PSORXI I $G(PSODAL("DA")) S $P(^TMP("PSODAOC",$J,"ALLERGY",PSJALGCT,"INTERVENTION"),"^")=PSODAL("DA") K PSODAL("DA")
- .K PSJRXI("DA"),PSODAL("DA")
- EX K DIR,DTOUT,DIRUT,DIROUT,DUOUT,Y,DSPLQ,PSOMDC,AGNL,SEV,SEV,ZGMRA,LPTR,ALTOT
- K PSOACK,GMRAING,GMRADRCL,GMRAREAC,GMRARSLT,I,APTR,GMRA,LP,^TMP($J,"PSODRCLS"),ZCLA,ZCNT,ZINSTL,ZSAT
- I $D(PSJDGCK)!$D(PSODGCK)!$G(PSORX("DFLG"))!$G(PSGORQF) K ^TMP("PSODAOC",$J)
- I '$G(PSJAOC) K PSGORQF
- Q
- ;
- DSPLY ;
- K PSOSYMS,PSOCAGNT
- D SORTN^PSODGAL3,FULL^VALM1
- K AGNL,SEV,SEVN,PSOHIS N INGLOC,ZINGLOC,ZMEDL,DACNT,DACNT2,ZSTA,ZDATE
- N ZZING,ZZLOC,ZZALL,PSOACNT,PSOLOCAL,PSOPTR,PSOSITT,PSOCA,ZLOC,PSOATYPE S (ALTOT,DACNT,DACNT2,ZLOC,ZCLA,PSOACNT,PSOATYPE)=0,ZMEDL=""
- S (ZZLOC,PSOCA,ZZALL,ZZING,PSOSEV,PSOINGR,PSOASITE,PSOIADAT,PSOGIEN,PSOADA)=""
- F S PSOSEV=$O(PSOCAGNT(PSOSEV)) Q:PSOSEV="" F S PSOCA=$O(PSOCAGNT(PSOSEV,PSOCA)) Q:PSOCA="" F S PSOATYPE=$O(PSOCAGNT(PSOSEV,PSOCA,PSOATYPE)) Q:PSOATYPE="" S ALTOT=ALTOT+1
- F S PSOSEV=$O(PSOCAGNT(PSOSEV)) Q:PSOSEV=""!($G(PSORX("DFLG")))!($G(PSGORQF)) F S PSOCA=$O(PSOCAGNT(PSOSEV,PSOCA)) Q:PSOCA=""!($G(PSORX("DFLG")))!($G(PSGORQF)) D
- .F S PSOATYPE=$O(PSOCAGNT(PSOSEV,PSOCA,PSOATYPE)) Q:PSOATYPE=""!($G(PSORX("DFLG")))!($G(PSGORQF)) D
- ..S PSOGMRA2=""
- ..S PSOGMRA2=PSOCAGNT(PSOSEV,PSOCA,PSOATYPE)
- ..S (PSOPTR,ZZALL,PSODRCL)=""
- ..S PSOPTR=$P($P(PSOGMRA2,"^",1),"|")
- ..S PSOSITT=$P($P(PSOGMRA2,"^",1),"|",4)
- ..S ZZALL=$$GMSGPTR(PSOPTR)
- ..Q:ZZALL=""
- ..D DSPLY1
- Q
- DSPLY1 ;
- ; 1 2 3 4 5 6 7 8 9 10
- N ZINDATE,ZSIGN,PSOINSTL,PSOSTA,PSOHIS,PSOSTYP,PSOMEDL,PSOLOCAL,PSODATA,PSOWCA,PSOCAR,PSOSTYPI,PSOLOCI,PSOMEDLI,PSOHISI,PSOSEVI,DRCLIEN,DRCLIENE,PSODCLAS,ZALL,ZMSG
- S PSOHISI=$P(GMRARSLT(PSOPTR,ZZALL),U,8)
- S PSOHIS=$S(PSOHISI="o":"OBSERVED",1:"HISTORICAL")
- S PSOASEV=$$GETSEV^PSODGAL3(PSOSITT,PSOPTR,.GMRARSLT)
- S PSOSEVT=PSOSEV
- S DACNT=DACNT+1
- S DACNT2=DACNT2+1
- S:PSOSEV=1 PSOSEVT1("S")=1
- W $C(7),!!,"A Drug-Allergy Reaction exists for this medication and/or class!",!
- W !,$S($G(PSODGCKF)!($G(PSJDGFLG)):" Profile Drug: ",1:" Prospective Drug: ")
- ;
- S PSORXORD=""
- N PSJCPROS,PSJNCOM,PROSPECT S (PSJCPROS,PSJNCOM,PROPSECT)=""
- I $G(PSJAOC) D
- .S PSORXORD=$S($G(PSJORD):PSJORD,$G(ON55):ON55,$G(ON):ON,$G(PSJNORD):PSJNORD,1:"")
- .I '$G(PSORXORD) S PSORXORD=$G(PSGORD)
- .;for complex UD orders display format: orderable item doseform (units) ex: MORPHINE TAB,SA (100MG)
- .I $G(PSJCOM) S PSJNCOM=$$FINDC^PSJDGAL2($G(PSORXORD)),PSJCPROS=$P(PSJNCOM,"^",2)
- .I '$G(PSJDGCK)&('$G(PSODGCK)) W $S($G(PSORXORD)["V":PSODRUG("OIN"),$G(PSORXORD)["P"&($D(^PS(53.1,+$G(PSORXORD),"AD"))):PSODRUG("OIN"),$G(PSJCOM):PSJCPROS,1:PSODRUG("NAME"))
- .I $G(PSJDGCK)!($G(PSODGCK)) W PSODRUG("NAME")
- E W PSODRUG("NAME")
- ;
- W !," Causative Agent: "
- S (PSOWCA,PSOCAR)="",PSOALGYF=1
- I PSOCA["/" D S PSOCAR=$E(PSOCAR,3,$L(PSOCAR))
- . F I=1:1 S PSOWCA=$P(PSOCA,"/",I) Q:PSOWCA="" S PSOCAR=PSOCAR_"/ "_PSOWCA
- I PSOCAR="" S PSOCAR=PSOCA
- ;
- K ^UTILITY($J,"W"),X S DIWL=1,DIWR=55,(X,DIWF)=""
- N CAUSAGNT S (X,PSODCLAS,CAUSAGNT,ZSITE)="",CAUSAGNT=PSOCAGNT(PSOSEV,PSOCA,PSOATYPE)
- ;
- SITE ;
- S X=""
- F II=1:1 S ZSITE=$P(CAUSAGNT,"^",II) Q:ZSITE="" D
- .S (ZDATE,PSOSNAM,ZZSITE,PSOLOCAL)=""
- .S ZZSITE=$P(ZSITE,"|",4),ZDATE=$P(ZSITE,"|",2),PSOLOCAL=$P(ZSITE,"|",3),ZMSG=$P(ZSITE,"|")
- .S PSOSNAM=$P(GMRARSLT(ZMSG,"MESSAGE",1,ZZSITE),U)
- .;;S PSOSNAM=$$GET1^DIQ(4,ZZSITE,.01)
- .S X=X_", "_PSOSNAM_" - "_$P(ZDATE,"@")
- S X=$S(X'="":PSOCAR_" ("_$E(X,3,9999)_")",1:PSOCAR)
- D ^DIWP,UTIL
- ;
- W " Historical/Observed: "_$P(PSOHIS,";")
- W !," Severity: "_$S(PSOASEV="":"Not Entered",1:PSOASEV)
- S (PSOOINGR,ZPOP)="" N Z,ZI,ZX,ZOV,PSOWINGR,PSOWIN,REMSITE,REMTMP
- S DIWL=1,DIWR=55,(X,DIWF)=""
- F S PSOINGR=$O(PSOCAGNT(PSOSEV,PSOCA,PSOATYPE,PSOINGR)) Q:PSOINGR=""!(PSOINGR="ZZZSYMPTOMS") D
- .I '$G(ZPOP) S ZPOP=1 W !?7," Ingredients: "
- .S X=X_", "_PSOINGR
- D ^DIWP,UTIL
- K ^UTILITY($J,"W"),DIWL,DIWR,DIWF,I,ZX,X,^TMP("PSN",$J),PSNDA,PSNID
- I $P(GMRARSLT(PSOPTR,"MESSAGE",2),U)]"" D SYM1 S ZSIGN=1
- I '$G(ZSIGN) W ?3," Signs/Symptoms: None Entered",!
- S PSOLOCAL="",PSOLOCAL=$P($P(ZZALL,"^",3),"|",2)
- ;
- DRCL ;PSODRCL1(99,"AMPICILLIN/SULBACTAM","PENICILLINS,AMINO DERIVATIVES")=1
- I $D(PSODRCL1(PSOSEV,PSOCA,PSOATYPE)) D
- .W ?8," Drug Class: "
- .N III,XX,X K ^UTILITY($J,"W") S DIWL=1,DIWR=55,(X,XX,DIWF)=""
- .F S XX=$O(PSODRCL1(PSOSEV,PSOCA,PSOATYPE,XX)) Q:XX="" D
- ..S DRCLIEN=PSODRCL1(PSOSEV,PSOCA,PSOATYPE,XX),DRCLIENE=$$GET1^DIQ(50.605,DRCLIEN,.01,"E")
- ..S X=X_", "_$S(DRCLIENE'="":DRCLIENE_" ",1:"")_XX
- .S X=$E(X,3,999) D ^DIWP
- .D UTIL
- D OVRD ;Override Reason
- S PSOACNT=PSOACNT+1
- I ALTOT>PSOACNT K DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to continue" D ^DIR
- I $D(DTOUT)!($D(DUOUT)) S:$G(PSJAOC) PSGORQF=1 S:'$G(PSJAOC) (PSODLQT,PSORX("DFLG"))=1 K DIR,DUOUT,DIRUT W @IOF
- Q
- ;
- OVRD ; Override Reason
- N Z,ZI,ZX,ZOV,ZORN,X,PSOPRET,PSOOVRDR K ^UTILITY($J,"W") S DIWL=1,DIWR=50,(ZOV,ZORN,DIWF)=""
- I '+$G(PSJORD) D G OVRDX
- .I $G(PSOFOERR) D Q
- ..S PSOOVRDR=+$P($G(^PS(52.41,ORD,0)),"^") S:PSOOVRDR ZORN=PSOOVRDR
- .I $G(PSOREINS) D Q
- ..I $G(ZRXN) S ZORN=$P(^PSRX(ZRXN,"OR1"),"^",2)
- .I $G(PSOVER1),$G(PSONV) S PSOOVRDR=+$P($G(^PSRX(PSONV,"OR1")),"^",2) S:PSOOVRDR ZORN=PSOOVRDR
- ;
- I '$G(PSJINFIN) G OVRDX
- I PSJORD["P" S ZORN=+$P($G(^PS(53.1,+PSJORD,0)),U,21) G OVRDX
- I PSJORD["U" S ZORN=+$P($G(^PS(55,DFN,5,+PSJORD,0)),U,21) G OVRDX
- I PSJORD["V" S ZORN=+$P($G(^PS(55,DFN,"IV",+PSJORD,0)),U,21)
- OVRDX ;
- G:'$G(ZORN) NF
- D GETOC4^OROCAPI1(ZORN,.PSOPRET)
- F ZI=0:0 S ZI=$O(PSOPRET(ZORN,"DATA",ZI)) Q:'ZI I $P($P(PSOPRET(ZORN,"DATA",ZI,1),"^"),";",2)=3,$G(PSOPRET(ZORN,"DATA",ZI,"OR",1,0))]"" S ZOV=$G(PSOPRET(ZORN,"DATA",ZI,"OR",1,0))
- S ^TMP("PSODAOC",$J,"ALLERGY","PROVR")=ZOV
- NF ;
- I '$G(PSODGCK)&('$G(PSJDGCK)) D
- .W !?3,"Provider Override Reason: " S X=$S($G(ZOV)]"":ZOV,1:"N/A - Order Check Not Evaluated by Provider") D ^DIWP
- .F ZX=0:0 S ZX=$O(^UTILITY($J,"W",1,ZX)) Q:'ZX W ?29,^UTILITY($J,"W",1,ZX,0),!
- .K ^UTILITY($J,"W"),DIWL,DIWR,DIWF,ZORN,RET
- ; pso*7*401
- I $D(PSOMDC) D
- .W !,"Warning: The following drug class does not exist in the VA DRUG CLASS"
- .W !,"file (#50.605). Please do a manual Drug-Allergy order check and notify"
- .W !,"the pharmacy ADPAC for follow up.",!
- .S PSOMDC="" F S PSOMDC=$O(PSOMDC(PSOMDC)) Q:PSOMDC="" W !,"VA Drug Class: "_PSOMDC,!
- .W ! S DIR("A")="Press Return to continue",DIR(0)="E",DIR("?")="Press Return to continue"
- .D ^DIR K DIR W !
- Q
- SYM1 ;format signs/symptoms
- N PSOSYMX,QX,ZSYM
- K ^UTILITY($J,"W"),X S DIWL=1,DIWR=55,DIWF=""
- S (ZSYM,PSOSYMX)="",QX=0
- F S ZSYM=$O(PSOSYMS(PSOSEV,PSOCA,PSOATYPE,"ZZZSYMPTOMS",ZSYM)) Q:ZSYM="" S QX=QX+1,PSOSYMX=PSOSYMX_", "_$P(ZSYM,";",1)
- S PSOSYMX=$E(PSOSYMX,3,999),X=PSOSYMX D ^DIWP
- W ?4," Signs/Symptoms: "
- N ZNODE F ZX=0:0 S ZX=$O(^UTILITY($J,"W",1,ZX)) Q:'ZX D
- .S ZNODE="",ZNODE=^UTILITY($J,"W",1,ZX,0)
- .I $E(ZNODE,1,2)=", " S ZNODE=$E(ZNODE,3,999)
- .W ?22,ZNODE,!
- K ^UTILITY($J,"W"),DIWL,DIWR,DIWF,I,ZX
- Q
- ;
- CRI ;input electronic sig
- N X1 D SIG^XUSESIG I X1="" D Q
- .K PSORX("INTERVENE"),DIR
- .I $G(PSJAOC) S PSGORQF=1
- .E S PSORX("DFLG")=1,VALMBCK="R"
- .S:$D(PSORENW) PSORENW("DFLG")=1
- .W !!,"With a SEVERE reaction, an Electronic Signature is required!",!
- .I $G(PSGCOPY)=1!($G(PSIVCOPY)=1) W !,"Order not copied!",!
- .I $G(PSJREN)=1 W !,"No changes made to this order!",!
- .S DIR("A")="Press Return to continue",DIR(0)="E",DIR("?")="Press Return to continue" D ^DIR K DIR W !
- S PSORX("INTERVENE")=1
- Q
- DIR ;
- S DIR("A")="Press Return to continue",DIR(0)="E",DIR("?")="Press Return to continue"
- D ^DIR K DIR W !
- Q
- ;
- UTIL ;
- N ZNODE F ZX=0:0 S ZX=$O(^UTILITY($J,"W",1,ZX)) Q:'ZX D
- .S ZNODE="",ZNODE=^UTILITY($J,"W",1,ZX,0)
- .I $E(ZNODE,1,2)=", " S ZNODE=$E(ZNODE,3,999)
- .W ?22,ZNODE,!
- K ^UTILITY($J,"W"),DIWL,DIWR,DIWF,I,ZX
- Q
- ;
- GMSGPTR(MSG,NODE) ; retrieve second level pointer from new allergy array
- N RESULT
- S RESULT=$O(GMRARSLT(MSG,$G(NODE)))
- Q:+RESULT>0 RESULT
- S:RESULT="MESSAGE" RESULT=$O(GMRARSLT(MSG,RESULT))
- Q:$E(RESULT,1)="R" RESULT
- S RESULT=""
- Q RESULT
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSODGAL1 12369 printed Feb 18, 2025@23:53:19 Page 2
- PSODGAL1 ;BIR/LC,SAB - enhanced DRUG ALLERGY REACTION CHECKING ;12/09/07 02:22
- +1 ;;7.0;OUTPATIENT PHARMACY;**251,401,390,424,429,411,500**;DEC 1997;Build 9
- +2 ;External reference to $$ORCHK2^GMRAOR supported by DBIA 2378
- +3 ;External reference to ^PS(50.605 supported by DBIA 696
- +4 ;External reference to ^XUSEC("PSORPH" supported by DBIA 10076
- +5 ;External reference to GETOC4^OROCAPI1 supported by DBIA 5729
- +6 ;External reference to ^PS(55 supported by DBIA 2228
- +7 ;External reference to ^PS(53.1 supported by DBIA 5793
- +8 ;External reference to ^PSJRXI supported by DBIA 6076
- +9 ;External reference to SIG^XUSESIG supported by DBIA 10050
- +10 ;External reference to $$FINDC^PSJDGAL2 supportedby DBIA 6140
- +11 ;
- EN ; Called from both inpatient and outpatient pharmacy
- +1 NEW PSOACK,DFN,PSODAL,RXN,LPTR,PSOSEVT,PSOSEVT1,NDF,PSOSYMS,PSOINGRE,PSOSORT,PSOGIEN,PSODGCL,PSODGCL1,I,II,PSOADA,PSOADAT,PSOASEV,PSOASITE,PSODRCL1,PSODRCL
- +2 NEW PSOINGR,PSOGMRA,PSOGMRA2,PSOIADAT,PSOLCLAS,PSOLOC,PSOOINGR,PSOSEV,PSOSNAM,PTR,TYP,ZPOP,ZPOP2,ZSITE,ZZSITE,PSOCAGNT,PSORXORD
- +3 KILL ^TMP($JOB,"PSODRCLS"),DSPLQ,PSOMDC,ZGMRA,GMRAING,GMRADRCL,GMRAREAC,PSOALGYF,PSOASORT,GMRARSLT
- +4 SET DFN=PSODFN
- +5 SET (NDF,TYP,PTR,PSOALGYF)=""
- +6 IF $DATA(PSODRUG("NDF"))
- IF PSODRUG("NDF")'=0
- SET NDF=$PIECE(PSODRUG("NDF"),"A")
- SET TYP=$PIECE(PSODRUG("NDF"),"A",2)
- SET PTR=$SELECT(NDF=0:"",1:NDF)_"."_TYP
- +7 SET $PIECE(PTR,".",3)=PSODRUG("IEN")
- +8 ;
- CHK ;matched to ndf
- +1 ;counter for inpatient; OP will always be 1
- if '$GET(PSJALGCT)
- SET PSJALGCT=1
- +2 KILL ZMED,ZMEDLCL
- SET PSOACK=$$ORCHK2^GMRAOR(DFN,"DR",PTR,"","GMRARSLT")
- if +$GET(PSOACK)>0
- Begin DoDot:1
- +3 DO DSPLY
- if $GET(PSORX("DFLG"))!($GET(PSGORQF))
- QUIT
- +4 if $DATA(^XUSEC("PSORPH",DUZ))!($GET(PSODGCK))
- QUIT
- +5 IF +$GET(PSOACK)=1
- Begin DoDot:2
- +6 NEW ZMSG,ZLOCAL,ZINGREDS,ZI,ZINGRED
- +7 SET ^TMP("PSODAI",$JOB,0)=1
- SET (PSOSEV,PSOLOC,PSODRG)=""
- +8 SET ZMSG=""
- FOR
- SET ZMSG=$ORDER(GMRARSLT(ZMSG))
- if 'ZMSG
- QUIT
- Begin DoDot:3
- +9 SET PSOGIEN=$$GMSGPTR(ZMSG)
- +10 if PSOGIEN=""
- QUIT
- +11 SET ZLOCAL=$SELECT($PIECE(GMRARSLT(ZMSG,PSOGIEN),U,2)="L":" (local)",1:" (remote)")
- +12 SET ZINGREDS=$GET(GMRARSLT(ZMSG,"MESSAGE","OFFENDERS","ING"))
- +13 if ZINGREDS=""
- QUIT
- +14 if $EXTRACT(ZINGREDS,1)="~"
- SET ZINGREDS=$EXTRACT(ZINGREDS,2,9999)
- +15 FOR ZI=1:1:$LENGTH(ZINGREDS,"~")
- SET ZINGRED=$PIECE(ZINGREDS,"~",ZI)
- if ZINGRED=""
- QUIT
- Begin DoDot:4
- +16 SET ^TMP("PSODAI",$JOB,ZI,0)=ZINGRED_ZLOCAL
- +17 QUIT
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +18 if $GET(PSORX("DFLG"))!($GET(PSGORQF))
- QUIT
- +19 SET NDF=$PIECE(PSODRUG("NDF"),"A")
- +20 IF +$GET(PSOACK)>0!$GET(^TMP($JOB,"PSODRCLS",0))
- Begin DoDot:1
- +21 IF '$DATA(^XUSEC("PSORPH",DUZ))
- IF '$DATA(PSOMDC)
- KILL DIR
- SET DIR(0)="E"
- SET DIR("?")="Press Return to continue"
- SET DIR("A")="Press Return to continue"
- DO ^DIR
- KILL DIR,DUOUT,DIRUT
- QUIT
- +22 IF $DATA(PSJDGCK)!$DATA(PSODGCK)
- KILL DIR
- SET DIR(0)="E"
- SET DIR("?")="Press Return to continue"
- SET DIR("A")="Press Return to continue"
- DO ^DIR
- KILL DIR,DUOUT,DIRUT
- WRITE @IOF
- QUIT
- +23 SET DIR("?",1)="Answer 'YES' if you DO want to enter a intervention for this medication,"
- SET DIR("?")=" 'NO' if you DON'T want to enter a intervention for this medication,"
- +24 SET DIR(0)="SA^1:YES;0:NO"
- SET DIR("A")="Do you want to Intervene? "
- SET DIR("B")="YES"
- DO ^DIR
- IF '$GET(PSJAOC)
- WRITE !
- +25 IF ($DATA(DTOUT))!($DATA(DUOUT))
- if '$GET(PSJAOC)
- SET (PSODLQT,PSORX("DFLG"))=1
- if $GET(PSJAOC)
- SET PSGORQF=1
- QUIT
- +26 IF 'Y
- if $GET(PSOSEVT1("S"))=1
- Begin DoDot:2
- +27 if $GET(PSJAOC)
- SET PSGORQF=1
- +28 if '$GET(PSJAOC)
- SET (PSORX("DFLG"),PSOQUIT)=1
- +29 WRITE !!,"With a SEVERE reaction, an intervention is required!",!
- SET VALMBCK="R"
- +30 ;set flag if COPY to not repeat this message in PSGOD
- IF $GET(PSGCOPY)=1!($GET(PSIVCOPY)=1)
- WRITE !,"Order not copied!",!
- SET PSJCOFLG=1
- +31 ;set flag if RENEW to not repeat this message in PSGOEE
- IF $GET(PSJREN)=1
- WRITE !,"No changes made to this order!",!
- SET PSJRNFLG=1
- +32 IF '$GET(PSOSPRNW)
- KILL DIR
- SET DIR(0)="E"
- SET DIR("?")="Press Return to continue"
- SET DIR("A")="Press Return to continue"
- DO ^DIR
- +33 if $GET(PSOSPRNW)
- SET PSORENW("DFLG")=1
- SET PSORX("DFLG")=0
- SET PSOQUIT=1
- +34 IF $DATA(DTOUT)!($DATA(DUOUT))
- Begin DoDot:3
- +35 ;inpatient
- IF $GET(PSJAOC)
- SET PSGORQF=1
- QUIT
- +36 SET (PSODLQT,PSOQUIT,PSORX("DFLG"))=1
- End DoDot:3
- KILL DIR,DUOUT,DIRUT
- WRITE !
- End DoDot:2
- QUIT
- +37 if $GET(PSOSEVT1("S"))=1
- DO CRI
- +38 if $GET(PSORX("DFLG"))!($GET(PSGORQF))
- QUIT
- +39 IF $GET(PSJAOC)
- SET PSJDAL=1
- DO ^PSJRXI
- IF $GET(PSJDAL("DA"))
- SET $PIECE(^TMP("PSODAOC",$JOB,"ALLERGY",PSJALGCT,"INTERVENTION"),"^")=PSJDAL("DA")
- KILL PSJDAL("DA")
- +40 IF '$GET(PSJAOC)
- SET PSODAL=1
- DO ^PSORXI
- IF $GET(PSODAL("DA"))
- SET $PIECE(^TMP("PSODAOC",$JOB,"ALLERGY",PSJALGCT,"INTERVENTION"),"^")=PSODAL("DA")
- KILL PSODAL("DA")
- +41 KILL PSJRXI("DA"),PSODAL("DA")
- End DoDot:1
- EX KILL DIR,DTOUT,DIRUT,DIROUT,DUOUT,Y,DSPLQ,PSOMDC,AGNL,SEV,SEV,ZGMRA,LPTR,ALTOT
- +1 KILL PSOACK,GMRAING,GMRADRCL,GMRAREAC,GMRARSLT,I,APTR,GMRA,LP,^TMP($JOB,"PSODRCLS"),ZCLA,ZCNT,ZINSTL,ZSAT
- +2 IF $DATA(PSJDGCK)!$DATA(PSODGCK)!$GET(PSORX("DFLG"))!$GET(PSGORQF)
- KILL ^TMP("PSODAOC",$JOB)
- +3 IF '$GET(PSJAOC)
- KILL PSGORQF
- +4 QUIT
- +5 ;
- DSPLY ;
- +1 KILL PSOSYMS,PSOCAGNT
- +2 DO SORTN^PSODGAL3
- DO FULL^VALM1
- +3 KILL AGNL,SEV,SEVN,PSOHIS
- NEW INGLOC,ZINGLOC,ZMEDL,DACNT,DACNT2,ZSTA,ZDATE
- +4 NEW ZZING,ZZLOC,ZZALL,PSOACNT,PSOLOCAL,PSOPTR,PSOSITT,PSOCA,ZLOC,PSOATYPE
- SET (ALTOT,DACNT,DACNT2,ZLOC,ZCLA,PSOACNT,PSOATYPE)=0
- SET ZMEDL=""
- +5 SET (ZZLOC,PSOCA,ZZALL,ZZING,PSOSEV,PSOINGR,PSOASITE,PSOIADAT,PSOGIEN,PSOADA)=""
- +6 FOR
- SET PSOSEV=$ORDER(PSOCAGNT(PSOSEV))
- if PSOSEV=""
- QUIT
- FOR
- SET PSOCA=$ORDER(PSOCAGNT(PSOSEV,PSOCA))
- if PSOCA=""
- QUIT
- FOR
- SET PSOATYPE=$ORDER(PSOCAGNT(PSOSEV,PSOCA,PSOATYPE))
- if PSOATYPE=""
- QUIT
- SET ALTOT=ALTOT+1
- +7 FOR
- SET PSOSEV=$ORDER(PSOCAGNT(PSOSEV))
- if PSOSEV=""!($GET(PSORX("DFLG")))!($GET(PSGORQF))
- QUIT
- FOR
- SET PSOCA=$ORDER(PSOCAGNT(PSOSEV,PSOCA))
- if PSOCA=""!($GET(PSORX("DFLG")))!($GET(PSGORQF))
- QUIT
- Begin DoDot:1
- +8 FOR
- SET PSOATYPE=$ORDER(PSOCAGNT(PSOSEV,PSOCA,PSOATYPE))
- if PSOATYPE=""!($GET(PSORX("DFLG")))!($GET(PSGORQF))
- QUIT
- Begin DoDot:2
- +9 SET PSOGMRA2=""
- +10 SET PSOGMRA2=PSOCAGNT(PSOSEV,PSOCA,PSOATYPE)
- +11 SET (PSOPTR,ZZALL,PSODRCL)=""
- +12 SET PSOPTR=$PIECE($PIECE(PSOGMRA2,"^",1),"|")
- +13 SET PSOSITT=$PIECE($PIECE(PSOGMRA2,"^",1),"|",4)
- +14 SET ZZALL=$$GMSGPTR(PSOPTR)
- +15 if ZZALL=""
- QUIT
- +16 DO DSPLY1
- End DoDot:2
- End DoDot:1
- +17 QUIT
- DSPLY1 ;
- +1 ; 1 2 3 4 5 6 7 8 9 10
- +2 NEW ZINDATE,ZSIGN,PSOINSTL,PSOSTA,PSOHIS,PSOSTYP,PSOMEDL,PSOLOCAL,PSODATA,PSOWCA,PSOCAR,PSOSTYPI,PSOLOCI,PSOMEDLI,PSOHISI,PSOSEVI,DRCLIEN,DRCLIENE,PSODCLAS,ZALL,ZMSG
- +3 SET PSOHISI=$PIECE(GMRARSLT(PSOPTR,ZZALL),U,8)
- +4 SET PSOHIS=$SELECT(PSOHISI="o":"OBSERVED",1:"HISTORICAL")
- +5 SET PSOASEV=$$GETSEV^PSODGAL3(PSOSITT,PSOPTR,.GMRARSLT)
- +6 SET PSOSEVT=PSOSEV
- +7 SET DACNT=DACNT+1
- +8 SET DACNT2=DACNT2+1
- +9 if PSOSEV=1
- SET PSOSEVT1("S")=1
- +10 WRITE $CHAR(7),!!,"A Drug-Allergy Reaction exists for this medication and/or class!",!
- +11 WRITE !,$SELECT($GET(PSODGCKF)!($GET(PSJDGFLG)):" Profile Drug: ",1:" Prospective Drug: ")
- +12 ;
- +13 SET PSORXORD=""
- +14 NEW PSJCPROS,PSJNCOM,PROSPECT
- SET (PSJCPROS,PSJNCOM,PROPSECT)=""
- +15 IF $GET(PSJAOC)
- Begin DoDot:1
- +16 SET PSORXORD=$SELECT($GET(PSJORD):PSJORD,$GET(ON55):ON55,$GET(ON):ON,$GET(PSJNORD):PSJNORD,1:"")
- +17 IF '$GET(PSORXORD)
- SET PSORXORD=$GET(PSGORD)
- +18 ;for complex UD orders display format: orderable item doseform (units) ex: MORPHINE TAB,SA (100MG)
- +19 IF $GET(PSJCOM)
- SET PSJNCOM=$$FINDC^PSJDGAL2($GET(PSORXORD))
- SET PSJCPROS=$PIECE(PSJNCOM,"^",2)
- +20 IF '$GET(PSJDGCK)&('$GET(PSODGCK))
- WRITE $SELECT($GET(PSORXORD)["V":PSODRUG("OIN"),$GET(PSORXORD)["P"&($DATA(^PS(53.1,+$GET(PSORXORD),"AD"))):PSODRUG("OIN"),$GET(PSJCOM):PSJCPROS,1:PSODRUG("NAME"))
- +21 IF $GET(PSJDGCK)!($GET(PSODGCK))
- WRITE PSODRUG("NAME")
- End DoDot:1
- +22 IF '$TEST
- WRITE PSODRUG("NAME")
- +23 ;
- +24 WRITE !," Causative Agent: "
- +25 SET (PSOWCA,PSOCAR)=""
- SET PSOALGYF=1
- +26 IF PSOCA["/"
- Begin DoDot:1
- +27 FOR I=1:1
- SET PSOWCA=$PIECE(PSOCA,"/",I)
- if PSOWCA=""
- QUIT
- SET PSOCAR=PSOCAR_"/ "_PSOWCA
- End DoDot:1
- SET PSOCAR=$EXTRACT(PSOCAR,3,$LENGTH(PSOCAR))
- +28 IF PSOCAR=""
- SET PSOCAR=PSOCA
- +29 ;
- +30 KILL ^UTILITY($JOB,"W"),X
- SET DIWL=1
- SET DIWR=55
- SET (X,DIWF)=""
- +31 NEW CAUSAGNT
- SET (X,PSODCLAS,CAUSAGNT,ZSITE)=""
- SET CAUSAGNT=PSOCAGNT(PSOSEV,PSOCA,PSOATYPE)
- +32 ;
- SITE ;
- +1 SET X=""
- +2 FOR II=1:1
- SET ZSITE=$PIECE(CAUSAGNT,"^",II)
- if ZSITE=""
- QUIT
- Begin DoDot:1
- +3 SET (ZDATE,PSOSNAM,ZZSITE,PSOLOCAL)=""
- +4 SET ZZSITE=$PIECE(ZSITE,"|",4)
- SET ZDATE=$PIECE(ZSITE,"|",2)
- SET PSOLOCAL=$PIECE(ZSITE,"|",3)
- SET ZMSG=$PIECE(ZSITE,"|")
- +5 SET PSOSNAM=$PIECE(GMRARSLT(ZMSG,"MESSAGE",1,ZZSITE),U)
- +6 ;;S PSOSNAM=$$GET1^DIQ(4,ZZSITE,.01)
- +7 SET X=X_", "_PSOSNAM_" - "_$PIECE(ZDATE,"@")
- End DoDot:1
- +8 SET X=$SELECT(X'="":PSOCAR_" ("_$EXTRACT(X,3,9999)_")",1:PSOCAR)
- +9 DO ^DIWP
- DO UTIL
- +10 ;
- +11 WRITE " Historical/Observed: "_$PIECE(PSOHIS,";")
- +12 WRITE !," Severity: "_$SELECT(PSOASEV="":"Not Entered",1:PSOASEV)
- +13 SET (PSOOINGR,ZPOP)=""
- NEW Z,ZI,ZX,ZOV,PSOWINGR,PSOWIN,REMSITE,REMTMP
- +14 SET DIWL=1
- SET DIWR=55
- SET (X,DIWF)=""
- +15 FOR
- SET PSOINGR=$ORDER(PSOCAGNT(PSOSEV,PSOCA,PSOATYPE,PSOINGR))
- if PSOINGR=""!(PSOINGR="ZZZSYMPTOMS")
- QUIT
- Begin DoDot:1
- +16 IF '$GET(ZPOP)
- SET ZPOP=1
- WRITE !?7," Ingredients: "
- +17 SET X=X_", "_PSOINGR
- End DoDot:1
- +18 DO ^DIWP
- DO UTIL
- +19 KILL ^UTILITY($JOB,"W"),DIWL,DIWR,DIWF,I,ZX,X,^TMP("PSN",$JOB),PSNDA,PSNID
- +20 IF $PIECE(GMRARSLT(PSOPTR,"MESSAGE",2),U)]""
- DO SYM1
- SET ZSIGN=1
- +21 IF '$GET(ZSIGN)
- WRITE ?3," Signs/Symptoms: None Entered",!
- +22 SET PSOLOCAL=""
- SET PSOLOCAL=$PIECE($PIECE(ZZALL,"^",3),"|",2)
- +23 ;
- DRCL ;PSODRCL1(99,"AMPICILLIN/SULBACTAM","PENICILLINS,AMINO DERIVATIVES")=1
- +1 IF $DATA(PSODRCL1(PSOSEV,PSOCA,PSOATYPE))
- Begin DoDot:1
- +2 WRITE ?8," Drug Class: "
- +3 NEW III,XX,X
- KILL ^UTILITY($JOB,"W")
- SET DIWL=1
- SET DIWR=55
- SET (X,XX,DIWF)=""
- +4 FOR
- SET XX=$ORDER(PSODRCL1(PSOSEV,PSOCA,PSOATYPE,XX))
- if XX=""
- QUIT
- Begin DoDot:2
- +5 SET DRCLIEN=PSODRCL1(PSOSEV,PSOCA,PSOATYPE,XX)
- SET DRCLIENE=$$GET1^DIQ(50.605,DRCLIEN,.01,"E")
- +6 SET X=X_", "_$SELECT(DRCLIENE'="":DRCLIENE_" ",1:"")_XX
- End DoDot:2
- +7 SET X=$EXTRACT(X,3,999)
- DO ^DIWP
- +8 DO UTIL
- End DoDot:1
- +9 ;Override Reason
- DO OVRD
- +10 SET PSOACNT=PSOACNT+1
- +11 IF ALTOT>PSOACNT
- KILL DIR
- SET DIR(0)="E"
- SET DIR("?")="Press Return to continue"
- SET DIR("A")="Press Return to continue"
- DO ^DIR
- +12 IF $DATA(DTOUT)!($DATA(DUOUT))
- if $GET(PSJAOC)
- SET PSGORQF=1
- if '$GET(PSJAOC)
- SET (PSODLQT,PSORX("DFLG"))=1
- KILL DIR,DUOUT,DIRUT
- WRITE @IOF
- +13 QUIT
- +14 ;
- OVRD ; Override Reason
- +1 NEW Z,ZI,ZX,ZOV,ZORN,X,PSOPRET,PSOOVRDR
- KILL ^UTILITY($JOB,"W")
- SET DIWL=1
- SET DIWR=50
- SET (ZOV,ZORN,DIWF)=""
- +2 IF '+$GET(PSJORD)
- Begin DoDot:1
- +3 IF $GET(PSOFOERR)
- Begin DoDot:2
- +4 SET PSOOVRDR=+$PIECE($GET(^PS(52.41,ORD,0)),"^")
- if PSOOVRDR
- SET ZORN=PSOOVRDR
- End DoDot:2
- QUIT
- +5 IF $GET(PSOREINS)
- Begin DoDot:2
- +6 IF $GET(ZRXN)
- SET ZORN=$PIECE(^PSRX(ZRXN,"OR1"),"^",2)
- End DoDot:2
- QUIT
- +7 IF $GET(PSOVER1)
- IF $GET(PSONV)
- SET PSOOVRDR=+$PIECE($GET(^PSRX(PSONV,"OR1")),"^",2)
- if PSOOVRDR
- SET ZORN=PSOOVRDR
- End DoDot:1
- GOTO OVRDX
- +8 ;
- +9 IF '$GET(PSJINFIN)
- GOTO OVRDX
- +10 IF PSJORD["P"
- SET ZORN=+$PIECE($GET(^PS(53.1,+PSJORD,0)),U,21)
- GOTO OVRDX
- +11 IF PSJORD["U"
- SET ZORN=+$PIECE($GET(^PS(55,DFN,5,+PSJORD,0)),U,21)
- GOTO OVRDX
- +12 IF PSJORD["V"
- SET ZORN=+$PIECE($GET(^PS(55,DFN,"IV",+PSJORD,0)),U,21)
- OVRDX ;
- +1 if '$GET(ZORN)
- GOTO NF
- +2 DO GETOC4^OROCAPI1(ZORN,.PSOPRET)
- +3 FOR ZI=0:0
- SET ZI=$ORDER(PSOPRET(ZORN,"DATA",ZI))
- if 'ZI
- QUIT
- IF $PIECE($PIECE(PSOPRET(ZORN,"DATA",ZI,1),"^"),";",2)=3
- IF $GET(PSOPRET(ZORN,"DATA",ZI,"OR",1,0))]""
- SET ZOV=$GET(PSOPRET(ZORN,"DATA",ZI,"OR",1,0))
- +4 SET ^TMP("PSODAOC",$JOB,"ALLERGY","PROVR")=ZOV
- NF ;
- +1 IF '$GET(PSODGCK)&('$GET(PSJDGCK))
- Begin DoDot:1
- +2 WRITE !?3,"Provider Override Reason: "
- SET X=$SELECT($GET(ZOV)]"":ZOV,1:"N/A - Order Check Not Evaluated by Provider")
- DO ^DIWP
- +3 FOR ZX=0:0
- SET ZX=$ORDER(^UTILITY($JOB,"W",1,ZX))
- if 'ZX
- QUIT
- WRITE ?29,^UTILITY($JOB,"W",1,ZX,0),!
- +4 KILL ^UTILITY($JOB,"W"),DIWL,DIWR,DIWF,ZORN,RET
- End DoDot:1
- +5 ; pso*7*401
- +6 IF $DATA(PSOMDC)
- Begin DoDot:1
- +7 WRITE !,"Warning: The following drug class does not exist in the VA DRUG CLASS"
- +8 WRITE !,"file (#50.605). Please do a manual Drug-Allergy order check and notify"
- +9 WRITE !,"the pharmacy ADPAC for follow up.",!
- +10 SET PSOMDC=""
- FOR
- SET PSOMDC=$ORDER(PSOMDC(PSOMDC))
- if PSOMDC=""
- QUIT
- WRITE !,"VA Drug Class: "_PSOMDC,!
- +11 WRITE !
- SET DIR("A")="Press Return to continue"
- SET DIR(0)="E"
- SET DIR("?")="Press Return to continue"
- +12 DO ^DIR
- KILL DIR
- WRITE !
- End DoDot:1
- +13 QUIT
- SYM1 ;format signs/symptoms
- +1 NEW PSOSYMX,QX,ZSYM
- +2 KILL ^UTILITY($JOB,"W"),X
- SET DIWL=1
- SET DIWR=55
- SET DIWF=""
- +3 SET (ZSYM,PSOSYMX)=""
- SET QX=0
- +4 FOR
- SET ZSYM=$ORDER(PSOSYMS(PSOSEV,PSOCA,PSOATYPE,"ZZZSYMPTOMS",ZSYM))
- if ZSYM=""
- QUIT
- SET QX=QX+1
- SET PSOSYMX=PSOSYMX_", "_$PIECE(ZSYM,";",1)
- +5 SET PSOSYMX=$EXTRACT(PSOSYMX,3,999)
- SET X=PSOSYMX
- DO ^DIWP
- +6 WRITE ?4," Signs/Symptoms: "
- +7 NEW ZNODE
- FOR ZX=0:0
- SET ZX=$ORDER(^UTILITY($JOB,"W",1,ZX))
- if 'ZX
- QUIT
- Begin DoDot:1
- +8 SET ZNODE=""
- SET ZNODE=^UTILITY($JOB,"W",1,ZX,0)
- +9 IF $EXTRACT(ZNODE,1,2)=", "
- SET ZNODE=$EXTRACT(ZNODE,3,999)
- +10 WRITE ?22,ZNODE,!
- End DoDot:1
- +11 KILL ^UTILITY($JOB,"W"),DIWL,DIWR,DIWF,I,ZX
- +12 QUIT
- +13 ;
- CRI ;input electronic sig
- +1 NEW X1
- DO SIG^XUSESIG
- IF X1=""
- Begin DoDot:1
- +2 KILL PSORX("INTERVENE"),DIR
- +3 IF $GET(PSJAOC)
- SET PSGORQF=1
- +4 IF '$TEST
- SET PSORX("DFLG")=1
- SET VALMBCK="R"
- +5 if $DATA(PSORENW)
- SET PSORENW("DFLG")=1
- +6 WRITE !!,"With a SEVERE reaction, an Electronic Signature is required!",!
- +7 IF $GET(PSGCOPY)=1!($GET(PSIVCOPY)=1)
- WRITE !,"Order not copied!",!
- +8 IF $GET(PSJREN)=1
- WRITE !,"No changes made to this order!",!
- +9 SET DIR("A")="Press Return to continue"
- SET DIR(0)="E"
- SET DIR("?")="Press Return to continue"
- DO ^DIR
- KILL DIR
- WRITE !
- End DoDot:1
- QUIT
- +10 SET PSORX("INTERVENE")=1
- +11 QUIT
- DIR ;
- +1 SET DIR("A")="Press Return to continue"
- SET DIR(0)="E"
- SET DIR("?")="Press Return to continue"
- +2 DO ^DIR
- KILL DIR
- WRITE !
- +3 QUIT
- +4 ;
- UTIL ;
- +1 NEW ZNODE
- FOR ZX=0:0
- SET ZX=$ORDER(^UTILITY($JOB,"W",1,ZX))
- if 'ZX
- QUIT
- Begin DoDot:1
- +2 SET ZNODE=""
- SET ZNODE=^UTILITY($JOB,"W",1,ZX,0)
- +3 IF $EXTRACT(ZNODE,1,2)=", "
- SET ZNODE=$EXTRACT(ZNODE,3,999)
- +4 WRITE ?22,ZNODE,!
- End DoDot:1
- +5 KILL ^UTILITY($JOB,"W"),DIWL,DIWR,DIWF,I,ZX
- +6 QUIT
- +7 ;
- GMSGPTR(MSG,NODE) ; retrieve second level pointer from new allergy array
- +1 NEW RESULT
- +2 SET RESULT=$ORDER(GMRARSLT(MSG,$GET(NODE)))
- +3 if +RESULT>0
- QUIT RESULT
- +4 if RESULT="MESSAGE"
- SET RESULT=$ORDER(GMRARSLT(MSG,RESULT))
- +5 if $EXTRACT(RESULT,1)="R"
- QUIT RESULT
- +6 SET RESULT=""
- +7 QUIT RESULT
- +8 ;