- PSJLMUT1 ;BIR/MLM - DRUG NAME DISPLAY ;Jul 05, 2018@08:53
- ;;5.0;INPATIENT MEDICATIONS;**4,27,29,49,58,107,110,146,175,201,181,281,329,373,426**;16 DEC 97;Build 4
- ;
- ; Reference to ^PS(55 is supported by DBIA# 2191.
- ; Reference to ^PS(50.7 is supported by DBIA# 2180.
- ; Reference to ^PS(50.606 is supported by DBIA# 2174.
- ; Reference to EN^PSODRDU2 is supported by DBIA# 2189.
- ; Reference to ^PSDRUG( is supported by DBIA 2192.
- ;
- DRGDISP(DFN,ON,NL,GL,NAME,DRUGONLY) ;
- ;; DRUGONLY = 1/0 - Only the drug name will be returned.
- ;; NL = The drug name display length
- ;; GL = The give line display length, total length-6 ("Give: ")
- ;; NAME(X) = Drug name and give line in displayable format.
- ;; ON = IEN#_U/P (U=Unit Dose; P=Pending)
- ;
- NEW F,OIND,MARX,MR,NOTGV,SCH,PSGUPDDO,PSGGV,X,PSGX,PSGINS,DRUGNAME
- K NAME S PSGINS=""
- S:ON["U" F="^PS(55,DFN,5,+ON,"
- I ON["P" S F="^PS(53.1,+ON,",X=$G(@(F_".3)")),PSGINS=$S(X]"":X,1:"")
- I $G(@(F_"0)"))="" S NAME(1)="NOT FOUND" Q
- S OIND=$G(@(F_".2)")),PSGUPDDO=$P(OIND,U,2),X=@(F_"0)"),NOTGV=$P(X,U,22),MR=$$ENMRN^PSGMI(+$P(X,U,3))
- I '+OIND,($P(X,U,4)'="U") NEW DRG D GTDRG^PSIVORFA F X="AD","SOL" Q:+OIND F PSGX=0:0 S PSGX=$O(DRG(X,PSGX)) Q:'PSGX S OIND=$P(DRG(X,PSGX),U,6) Q:+OIND
- S SCH=$P($G(@(F_"2)")),U)
- I +$O(@(F_"1,0)")),'+$O(@(F_"1,1)")),PSGUPDDO="" D DD(F,.DRUGNAME)
- S:($G(DRUGNAME)=""!($G(DRUGNAME)["NOT FOUND")) DRUGNAME=$$OIDF(OIND)
- ;S PSGGV=$S(NOTGV:"*** NOT TO BE GIVEN *** ",1:"")_PSGINS_PSGUPDDO_" "_MR_" "_SCH
- S PSGGV=$S(NOTGV:"*** NOT TO BE GIVEN *** ",1:"")_$S(('$D(PSJPDDDP)&('$L(PSGUPDDO))):PSGINS,1:PSGUPDDO)_" "_MR_" "_SCH
- S PSGX=0 K PSJPDDDP
- D TXT^PSGMUTL(DRUGNAME,NL) F X=0:0 S X=$O(MARX(X)) Q:'X S NAME(X)=$S(X>1:" ",1:"")_MARX(X),PSGX=X
- Q:+DRUGONLY
- D TXT^PSGMUTL(PSGGV,GL) F X=0:0 S X=$O(MARX(X)) Q:'X D
- . I X=1 S NAME(PSGX+X)="Give: "_MARX(X) Q
- . S NAME(PSGX+X)=$S(X>1:" ",1:"")_MARX(X)
- Q
- OIDF(OIND) ; Return Orderable Item name and Dosage form.
- ;; +OIND = orderable item IEN
- NEW X,NAME
- S X=$G(^PS(50.7,+OIND,0))
- S:$P(X,U)]"" NAME=$P(X,U)_" "_$P($G(^PS(50.606,+$P(X,U,2),0)),U)
- Q $S($G(NAME)]"":NAME,1:"NOT FOUND "_+OIND_";PS(50.7")
- ;
- DD(F,NAME) ; Return Dispense drug name.
- ;; F = "^PS(55,DFN,5,+ON," or "^PS(53.1,+ON,"
- NEW X K NAME
- S X=$O(@(F_"1,0)")),X=$G(@(F_"1,"_+X_",0)"))
- I $P(X,U)]"" S NAME=$P($G(^PSDRUG(+X,0)),U)
- E S NAME="NOT FOUND "_+X_";PSDRUG"
- I '$O(@(F_"1,1)")),+$P(X,U,2)>1 S PSGUPDDO=+$P(X,U,2)
- S PSJPDDDP=1
- Q
- DSPLORDU(PSGP,ON) ; Display UD order for order check as in the Inpat Profile.
- NEW DRUGNAME,F,NODE0,NODE2,PSJID,PSJX,SCH,SD,STAT,X,Y
- S F=$S(ON["U":"^PS(55,PSGP,5,"_+ON_",",1:"^PS(53.1,"_+ON_",")
- S NODE0=$G(@(F_"0)")),NODE2=$G(@(F_"2)"))
- D DRGDISP^PSJLMUT1(PSGP,ON,39,54,.DRUGNAME,0)
- I ON["P",$P(NODE0,U,4)="F" D DSPLORDV(PSGP,ON) Q
- S SCH=$P(NODE0,U,7)
- S STAT=$P(NODE0,U,9) I STAT="A",$P(NODE0,U,27)="R" S STAT="R"
- I STAT="D" S STAT=$P(NODE0,U,28)
- I STAT'="P" S PSJID=$E($$ENDTC^PSGMI($P(NODE2,U,2)),1,5),SD=$E($$ENDTC^PSGMI($P(NODE2,U,4)),1,5)
- I STAT="P" S (PSJID,SD)="*****",SCH="?"
- F PSJX=0:0 S PSJX=$O(DRUGNAME(PSJX)) Q:'PSJX D
- . S:PSJX=1 X=SCH_" "_PSJID_" "_SD_" "_$E(STAT,1,2)
- . S:PSJX=1 DRUGNAME(1)=$$SETSTR^VALM1(X,$E(DRUGNAME(1),1,40),42,20)
- . S PSJOC(ON,PSJLINE)=" "_DRUGNAME(PSJX)
- . S PSJLINE=PSJLINE+1
- Q
- DSPLORDV(DFN,ON) ; Display IV order for order check as in the Inpat Profile.
- N DRG,DRGI,DRGT,DRGX,FIL,ND,ON55,P,PSJIVFLG,PSJORIFN,TYP,X,Y,COMPDRG
- S TYP="?" I ON["V" D
- .S Y=$G(^PS(55,DFN,"IV",+ON,0)) F X=2,3,4,5,8,9,17,23 S P(X)=$P(Y,U,X)
- .S:P(17)="D" P(17)=$P(Y,U,25)
- .S TYP=$$ONE^PSJBCMA(DFN,ON,P(9),P(2),P(3)) I TYP'="O" S TYP="C"
- .S ON55=ON,P("OT")=$S(P(4)="A":"F",P(4)="H":"H",1:"I") D GTDRG^PSIVORFB,GTOT^PSIVUTL(P(4))
- S PSJCT=0,PSJL=""
- I ON'["V" S (P(2),P(3))="",P(17)=$P($G(^PS(53.1,+ON,0)),U,9),Y=$G(^(8)),P(4)=$P(Y,U),P(8)=$P(Y,U,5),P(9)=$P($G(^(2)),U) D GTDRG^PSIVORFA,GTOT^PSIVUTL(P(4))
- S PSJIVFLG=1 D PIVAD,SOL
- Q
- SOL ;
- S PSJL=$S($G(PSJIVFLG):PSJL,1:"")_" in"
- S DRG=0 F S DRG=+$O(DRG("SOL",DRG)) Q:'DRG D NAME^PSIVUTL(DRG("SOL",DRG),37,.NAME,0) S DRGX=0 F S DRGX=$O(NAME(DRGX)) Q:'DRGX D
- .S COMPDRG="",COMPDRG=$P(DRG("SOL",DRG),"^",2)_" "_$P(DRG("SOL",DRG),"^",3)
- .I PSJL[" in" D
- ..I $D(PSJP(2)),COMPDRG=PSJP(2) S NAME(DRGX)="*"_NAME(DRGX) Q
- ..I $D(PSJOCDT(10,COMPDRG))!($D(PSJOCDT(20,COMPDRG))) D Q ;PSJ*5*281 - identify the interacting drugs with an *
- ...S NAME(DRGX)="*"_NAME(DRGX) Q
- .I PSJL'[" in" S NAME(DRGX)=NAME(DRGX)
- .S PSJL=$$SETSTR^VALM1(NAME(DRGX),PSJL,13,60) D:$G(PSJIVFLG) PIV1 D SETTMP S PSJL=" "
- Q
- PIVAD ; Print IV Additives.
- F DRG=0:0 S DRG=$O(DRG("AD",DRG)) Q:'DRG D NAME^PSIVUTL(DRG("AD",DRG),39,.NAME,1) F DRGX=0:0 S DRGX=$O(NAME(DRGX)) Q:'DRGX D
- .D ;PSJ*5*281 - identify the interacting drugs with an *
- ..I $D(PSJP(2)),NAME(DRGX)=PSJP(2) S NAME(DRGX)="*"_NAME(DRGX) Q
- ..I $D(PSJOCDT(10,NAME(DRGX)))!($D(PSJOCDT(20,NAME(DRGX)))) S NAME(DRGX)="*"_NAME(DRGX) Q
- ..S NAME(DRGX)=" "_NAME(DRGX)
- .S PSJL=$$SETSTR^VALM1(NAME(DRGX),PSJL,9,60) D:$G(PSJIVFLG) PIV1 D SETTMP
- Q
- ;
- PIV1 ; Print Sched type, start/stop dates, and status.
- K PSJIVFLG
- ;373 start
- ;F X=2,3 S P(X)=$E($$ENDTC^PSGMI(P(X)),1,$S($D(PSJEXTP):8,1:5))
- ;I '$D(PSJEXTP) S PSJL=$$SETSTR^VALM1(TYP,PSJL,50,1),PSJL=$$SETSTR^VALM1(P(2),PSJL,53,7),PSJL=$$SETSTR^VALM1(P(3),PSJL,60,7),PSJL=$$SETSTR^VALM1(P(17),PSJL,67,2)
- ;E S PSJL=$$SETSTR^VALM1(TYP,PSJL,50,1),PSJL=$$SETSTR^VALM1(P(2),53,7),PSJL=$$SETSTR^VALM1(P(3),PSJL,63,7),PSJL=$$SETSTR^VALM1(P(17),PSJL,73,2)
- F X=2,3 S P(X)=$E($$ENDTC2^PSGMI(P(X)),1,$S($D(PSJEXTP):8,1:10))
- I '$D(PSJEXTP) S PSJL=$$SETSTR^VALM1(TYP,PSJL,50,1),PSJL=$$SETSTR^VALM1(P(2),PSJL,53,10),PSJL=$$SETSTR^VALM1(P(3),PSJL,64,10),PSJL=$$SETSTR^VALM1(P(17),PSJL,75,2)
- E S PSJL=$$SETSTR^VALM1(TYP,PSJL,50,1),PSJL=$$SETSTR^VALM1(P(2),53,10),PSJL=$$SETSTR^VALM1(P(3),PSJL,64,10),PSJL=$$SETSTR^VALM1(P(17),PSJL,75,2)
- ;373 end
- Q
- SETTMP ;
- S PSJOC(ON,PSJLINE)=PSJL,PSJLINE=PSJLINE+1
- Q
- ORDCHK(DFN,TYPE,PIECE) ;
- ;TYPE ="DD" - Duplicate drug
- ; ="DC" - Duplicate class
- ; -"DI" - Drug Interaction
- ;PIECE = The piece order number is return from ^TMP($J,"DD"...
- ;PSJOC(ON,x) = Array of inpatient orders to be displayed
- ;
- NEW ON,PSJL,PSIVX,PSJOC,PSJORIEN,PSJPACK,PSJLINE
- S PSJOC=0,PSJLINE=1
- F PSIVX=0:0 S PSIVX=$O(^TMP($J,TYPE,PSIVX)) Q:'PSIVX D
- . S PSJPACK=$P(^TMP($J,TYPE,PSIVX,0),U,PIECE)
- . I $G(PSGORD) S PSJORD=PSGORD ; Set PSJORD if PSGORD exists and is not Null
- . I $G(PSJORD)]"" I $S($D(PSJORD):$G(PSJORD),1:$G(PSGORD))'["V",$P(PSJPACK,";")=$S($D(PSJORD):$G(PSJORD),1:$G(PSGORD)) Q ; don't flag order that is being renewed as duplicate, only checks Unit Dose orders
- . I $G(PSJCOM),($G(PSJORD)["P") Q:$D(^PS(53.1,"ACX",PSJCOM,+PSJPACK))
- . ; Don't flag if pending renewal from CPRS
- . I $G(PSJORD)]"",(PSJORD["P"),($P($G(^PS(53.1,+PSJORD,0)),"^",24)="R"),($P(PSJPACK,";")["U"),($P($G(^PS(55,DFN,5,+$P(PSJPACK,";"),0)),"^",27)="R"),($P($G(^PS(55,DFN,5,+$P(PSJPACK,";"),0)),"^",26)=PSJORD) Q
- . I $G(PSIVRNFG),$G(ON55)["V",$P(PSJPACK,";")=$G(ON55) Q ;PSIVRNFG set and kill in R+2^PSIVOPT2. Needed to do dupl. check on new order but not renew.
- . S PSJORIEN=$P(^TMP($J,TYPE,PSIVX,0),U,PIECE-1)
- . I TYPE="DI",($P(^TMP($J,TYPE,PSIVX,0),U,4)="CRITICAL") S PSJIREQ=1
- . ; Adding Drug Interactions check for use in Intervention defaults in PSJRXI.
- . I TYPE="DI" S PSJRXREQ=$S($P(^TMP($J,TYPE,PSIVX,0),U,4)="CRITICAL":"CRITICAL DRUG INTERACTION",1:"SIGNIFICANT DRUG INTERACTION")
- . ;I $P(PSJPACK,";",2)["O" D Q
- . N X S X=$P(PSJPACK,";",2) I X["O" D Q
- .. D:PSJFST=1 PAUSE
- .. W !!,"The patient has this "_$S($P(PSJPACK,";")["N":"Non-VA Meds",$P(PSJPACK,";",2)["O":"Outpatient",1:"")_" order:",!
- .. I $D(^TMP($J,TYPE,PSIVX,1)) D SHOR^PSJLMUT2(TYPE,PSIVX),PAUSE S PSJFST=$S(PSJFST=0:PSJFST+2,1:PSJFST+1) Q
- .. D EN^PSODRDU2(DFN,PSJPACK,"PSJPRE"),PAUSE S PSJPDRG=1,PSJFST=$S(PSJFST=0:PSJFST+2,1:PSJFST+1)
- . S ON=$P(PSJPACK,";") Q:$D(PSJOC(ON))
- . I ON=$G(PSIVOCON),+PSJORIEN Q
- . I ON=$G(PSIVOCON),'+PSJORIEN D SETPSJOC Q
- . ;S PSJOC=PSJOC+1,PSJPDRG=1 D:PSJOC=1 WRITE(TYPE)
- . I ON["V" D
- .. I '$O(^PS(55,DFN,"IV",+ON,0)) D SETPSJOC Q
- .. D DSPLORDV(DFN,ON) S PSJOC=PSJOC+1
- . I ON'["V" D DSPLORDU(DFN,ON) S PSJOC=PSJOC+1
- . S PSJOC(ON,PSJLINE)="",PSJLINE=PSJLINE+1
- D:PSJOC WRITE(TYPE)
- S ON="" F S ON=$O(PSJOC(ON)) Q:ON="" W ! S PSJLINE=PSJLINE+1,PSJFST=PSJFST+1 D
- . F PSIVX=0:0 S PSIVX=$O(PSJOC(ON,PSIVX)) Q:'PSIVX W !,PSJOC(ON,PSIVX) S PSJLINE=PSJLINE+1 D:'(PSIVX#6) PAUSE
- W !
- Q
- SETPSJOC ;Set PSJOC array to be displayed later
- NEW PIECE S PIECE=$S(TYPE="DC":4,1:2)
- S X=$$SETSTR^VALM1($P(^TMP($J,TYPE,PSIVX,0),U,PIECE),"",9,40)
- S X=$$SETSTR^VALM1("* EXISTS IN CURRENT ORDER *",X,50,27)
- S PSJOC(ON,PSJLINE)=X,PSJLINE=PSJLINE+1,PSJOC=PSJOC+1
- Q
- WRITE(TYPE) ;Display order check description
- S PSJPDRG=1
- I TYPE="DD" W !!,"This patient is already receiving the following order",$S(PSJOC>1:"s",1:"")," for ",$S($G(PSJDD)]"":$P($G(^PSDRUG(PSJDD,0)),U),1:"this drug"),":",!
- I TYPE="DC" W !!,"This patient is already receiving ",$S(PSJOC>1:"orders",1:"an order")," for the following drug",$S(PSJOC>1:"s",1:"")," in the same",!,"class as ",$S($G(PSJDD)]"":$P($G(^PSDRUG(PSJDD,0)),U),1:"the drug selected"),":",!
- I TYPE="DI" W !!,"This patient is receiving the following medication",$S(PSJOC>1:"s",1:"")," that ha",$S(PSJOC>1:"ve",1:"s")," an interaction",!,"with ",$P($G(^PSDRUG(PSJDD,0)),U),":",!
- Q
- PAUSE ;
- K DIR W ! S DIR(0)="EA",DIR("A")="Press Return to continue..." D ^DIR W !
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJLMUT1 9682 printed Jan 18, 2025@03:08:46 Page 2
- PSJLMUT1 ;BIR/MLM - DRUG NAME DISPLAY ;Jul 05, 2018@08:53
- +1 ;;5.0;INPATIENT MEDICATIONS;**4,27,29,49,58,107,110,146,175,201,181,281,329,373,426**;16 DEC 97;Build 4
- +2 ;
- +3 ; Reference to ^PS(55 is supported by DBIA# 2191.
- +4 ; Reference to ^PS(50.7 is supported by DBIA# 2180.
- +5 ; Reference to ^PS(50.606 is supported by DBIA# 2174.
- +6 ; Reference to EN^PSODRDU2 is supported by DBIA# 2189.
- +7 ; Reference to ^PSDRUG( is supported by DBIA 2192.
- +8 ;
- DRGDISP(DFN,ON,NL,GL,NAME,DRUGONLY) ;
- +1 ;; DRUGONLY = 1/0 - Only the drug name will be returned.
- +2 ;; NL = The drug name display length
- +3 ;; GL = The give line display length, total length-6 ("Give: ")
- +4 ;; NAME(X) = Drug name and give line in displayable format.
- +5 ;; ON = IEN#_U/P (U=Unit Dose; P=Pending)
- +6 ;
- +7 NEW F,OIND,MARX,MR,NOTGV,SCH,PSGUPDDO,PSGGV,X,PSGX,PSGINS,DRUGNAME
- +8 KILL NAME
- SET PSGINS=""
- +9 if ON["U"
- SET F="^PS(55,DFN,5,+ON,"
- +10 IF ON["P"
- SET F="^PS(53.1,+ON,"
- SET X=$GET(@(F_".3)"))
- SET PSGINS=$SELECT(X]"":X,1:"")
- +11 IF $GET(@(F_"0)"))=""
- SET NAME(1)="NOT FOUND"
- QUIT
- +12 SET OIND=$GET(@(F_".2)"))
- SET PSGUPDDO=$PIECE(OIND,U,2)
- SET X=@(F_"0)")
- SET NOTGV=$PIECE(X,U,22)
- SET MR=$$ENMRN^PSGMI(+$PIECE(X,U,3))
- +13 IF '+OIND
- IF ($PIECE(X,U,4)'="U")
- NEW DRG
- DO GTDRG^PSIVORFA
- FOR X="AD","SOL"
- if +OIND
- QUIT
- FOR PSGX=0:0
- SET PSGX=$ORDER(DRG(X,PSGX))
- if 'PSGX
- QUIT
- SET OIND=$PIECE(DRG(X,PSGX),U,6)
- if +OIND
- QUIT
- +14 SET SCH=$PIECE($GET(@(F_"2)")),U)
- +15 IF +$ORDER(@(F_"1,0)"))
- IF '+$ORDER(@(F_"1,1)"))
- IF PSGUPDDO=""
- DO DD(F,.DRUGNAME)
- +16 if ($GET(DRUGNAME)=""!($GET(DRUGNAME)["NOT FOUND"))
- SET DRUGNAME=$$OIDF(OIND)
- +17 ;S PSGGV=$S(NOTGV:"*** NOT TO BE GIVEN *** ",1:"")_PSGINS_PSGUPDDO_" "_MR_" "_SCH
- +18 SET PSGGV=$SELECT(NOTGV:"*** NOT TO BE GIVEN *** ",1:"")_$SELECT(('$DATA(PSJPDDDP)&('$LENGTH(PSGUPDDO))):PSGINS,1:PSGUPDDO)_" "_MR_" "_SCH
- +19 SET PSGX=0
- KILL PSJPDDDP
- +20 DO TXT^PSGMUTL(DRUGNAME,NL)
- FOR X=0:0
- SET X=$ORDER(MARX(X))
- if 'X
- QUIT
- SET NAME(X)=$SELECT(X>1:" ",1:"")_MARX(X)
- SET PSGX=X
- +21 if +DRUGONLY
- QUIT
- +22 DO TXT^PSGMUTL(PSGGV,GL)
- FOR X=0:0
- SET X=$ORDER(MARX(X))
- if 'X
- QUIT
- Begin DoDot:1
- +23 IF X=1
- SET NAME(PSGX+X)="Give: "_MARX(X)
- QUIT
- +24 SET NAME(PSGX+X)=$SELECT(X>1:" ",1:"")_MARX(X)
- End DoDot:1
- +25 QUIT
- OIDF(OIND) ; Return Orderable Item name and Dosage form.
- +1 ;; +OIND = orderable item IEN
- +2 NEW X,NAME
- +3 SET X=$GET(^PS(50.7,+OIND,0))
- +4 if $PIECE(X,U)]""
- SET NAME=$PIECE(X,U)_" "_$PIECE($GET(^PS(50.606,+$PIECE(X,U,2),0)),U)
- +5 QUIT $SELECT($GET(NAME)]"":NAME,1:"NOT FOUND "_+OIND_";PS(50.7")
- +6 ;
- DD(F,NAME) ; Return Dispense drug name.
- +1 ;; F = "^PS(55,DFN,5,+ON," or "^PS(53.1,+ON,"
- +2 NEW X
- KILL NAME
- +3 SET X=$ORDER(@(F_"1,0)"))
- SET X=$GET(@(F_"1,"_+X_",0)"))
- +4 IF $PIECE(X,U)]""
- SET NAME=$PIECE($GET(^PSDRUG(+X,0)),U)
- +5 IF '$TEST
- SET NAME="NOT FOUND "_+X_";PSDRUG"
- +6 IF '$ORDER(@(F_"1,1)"))
- IF +$PIECE(X,U,2)>1
- SET PSGUPDDO=+$PIECE(X,U,2)
- +7 SET PSJPDDDP=1
- +8 QUIT
- DSPLORDU(PSGP,ON) ; Display UD order for order check as in the Inpat Profile.
- +1 NEW DRUGNAME,F,NODE0,NODE2,PSJID,PSJX,SCH,SD,STAT,X,Y
- +2 SET F=$SELECT(ON["U":"^PS(55,PSGP,5,"_+ON_",",1:"^PS(53.1,"_+ON_",")
- +3 SET NODE0=$GET(@(F_"0)"))
- SET NODE2=$GET(@(F_"2)"))
- +4 DO DRGDISP^PSJLMUT1(PSGP,ON,39,54,.DRUGNAME,0)
- +5 IF ON["P"
- IF $PIECE(NODE0,U,4)="F"
- DO DSPLORDV(PSGP,ON)
- QUIT
- +6 SET SCH=$PIECE(NODE0,U,7)
- +7 SET STAT=$PIECE(NODE0,U,9)
- IF STAT="A"
- IF $PIECE(NODE0,U,27)="R"
- SET STAT="R"
- +8 IF STAT="D"
- SET STAT=$PIECE(NODE0,U,28)
- +9 IF STAT'="P"
- SET PSJID=$EXTRACT($$ENDTC^PSGMI($PIECE(NODE2,U,2)),1,5)
- SET SD=$EXTRACT($$ENDTC^PSGMI($PIECE(NODE2,U,4)),1,5)
- +10 IF STAT="P"
- SET (PSJID,SD)="*****"
- SET SCH="?"
- +11 FOR PSJX=0:0
- SET PSJX=$ORDER(DRUGNAME(PSJX))
- if 'PSJX
- QUIT
- Begin DoDot:1
- +12 if PSJX=1
- SET X=SCH_" "_PSJID_" "_SD_" "_$EXTRACT(STAT,1,2)
- +13 if PSJX=1
- SET DRUGNAME(1)=$$SETSTR^VALM1(X,$EXTRACT(DRUGNAME(1),1,40),42,20)
- +14 SET PSJOC(ON,PSJLINE)=" "_DRUGNAME(PSJX)
- +15 SET PSJLINE=PSJLINE+1
- End DoDot:1
- +16 QUIT
- DSPLORDV(DFN,ON) ; Display IV order for order check as in the Inpat Profile.
- +1 NEW DRG,DRGI,DRGT,DRGX,FIL,ND,ON55,P,PSJIVFLG,PSJORIFN,TYP,X,Y,COMPDRG
- +2 SET TYP="?"
- IF ON["V"
- Begin DoDot:1
- +3 SET Y=$GET(^PS(55,DFN,"IV",+ON,0))
- FOR X=2,3,4,5,8,9,17,23
- SET P(X)=$PIECE(Y,U,X)
- +4 if P(17)="D"
- SET P(17)=$PIECE(Y,U,25)
- +5 SET TYP=$$ONE^PSJBCMA(DFN,ON,P(9),P(2),P(3))
- IF TYP'="O"
- SET TYP="C"
- +6 SET ON55=ON
- SET P("OT")=$SELECT(P(4)="A":"F",P(4)="H":"H",1:"I")
- DO GTDRG^PSIVORFB
- DO GTOT^PSIVUTL(P(4))
- End DoDot:1
- +7 SET PSJCT=0
- SET PSJL=""
- +8 IF ON'["V"
- SET (P(2),P(3))=""
- SET P(17)=$PIECE($GET(^PS(53.1,+ON,0)),U,9)
- SET Y=$GET(^(8))
- SET P(4)=$PIECE(Y,U)
- SET P(8)=$PIECE(Y,U,5)
- SET P(9)=$PIECE($GET(^(2)),U)
- DO GTDRG^PSIVORFA
- DO GTOT^PSIVUTL(P(4))
- +9 SET PSJIVFLG=1
- DO PIVAD
- DO SOL
- +10 QUIT
- SOL ;
- +1 SET PSJL=$SELECT($GET(PSJIVFLG):PSJL,1:"")_" in"
- +2 SET DRG=0
- FOR
- SET DRG=+$ORDER(DRG("SOL",DRG))
- if 'DRG
- QUIT
- DO NAME^PSIVUTL(DRG("SOL",DRG),37,.NAME,0)
- SET DRGX=0
- FOR
- SET DRGX=$ORDER(NAME(DRGX))
- if 'DRGX
- QUIT
- Begin DoDot:1
- +3 SET COMPDRG=""
- SET COMPDRG=$PIECE(DRG("SOL",DRG),"^",2)_" "_$PIECE(DRG("SOL",DRG),"^",3)
- +4 IF PSJL[" in"
- Begin DoDot:2
- +5 IF $DATA(PSJP(2))
- IF COMPDRG=PSJP(2)
- SET NAME(DRGX)="*"_NAME(DRGX)
- QUIT
- +6 ;PSJ*5*281 - identify the interacting drugs with an *
- IF $DATA(PSJOCDT(10,COMPDRG))!($DATA(PSJOCDT(20,COMPDRG)))
- Begin DoDot:3
- +7 SET NAME(DRGX)="*"_NAME(DRGX)
- QUIT
- End DoDot:3
- QUIT
- End DoDot:2
- +8 IF PSJL'[" in"
- SET NAME(DRGX)=NAME(DRGX)
- +9 SET PSJL=$$SETSTR^VALM1(NAME(DRGX),PSJL,13,60)
- if $GET(PSJIVFLG)
- DO PIV1
- DO SETTMP
- SET PSJL=" "
- End DoDot:1
- +10 QUIT
- PIVAD ; Print IV Additives.
- +1 FOR DRG=0:0
- SET DRG=$ORDER(DRG("AD",DRG))
- if 'DRG
- QUIT
- DO NAME^PSIVUTL(DRG("AD",DRG),39,.NAME,1)
- FOR DRGX=0:0
- SET DRGX=$ORDER(NAME(DRGX))
- if 'DRGX
- QUIT
- Begin DoDot:1
- +2 ;PSJ*5*281 - identify the interacting drugs with an *
- Begin DoDot:2
- +3 IF $DATA(PSJP(2))
- IF NAME(DRGX)=PSJP(2)
- SET NAME(DRGX)="*"_NAME(DRGX)
- QUIT
- +4 IF $DATA(PSJOCDT(10,NAME(DRGX)))!($DATA(PSJOCDT(20,NAME(DRGX))))
- SET NAME(DRGX)="*"_NAME(DRGX)
- QUIT
- +5 SET NAME(DRGX)=" "_NAME(DRGX)
- End DoDot:2
- +6 SET PSJL=$$SETSTR^VALM1(NAME(DRGX),PSJL,9,60)
- if $GET(PSJIVFLG)
- DO PIV1
- DO SETTMP
- End DoDot:1
- +7 QUIT
- +8 ;
- PIV1 ; Print Sched type, start/stop dates, and status.
- +1 KILL PSJIVFLG
- +2 ;373 start
- +3 ;F X=2,3 S P(X)=$E($$ENDTC^PSGMI(P(X)),1,$S($D(PSJEXTP):8,1:5))
- +4 ;I '$D(PSJEXTP) S PSJL=$$SETSTR^VALM1(TYP,PSJL,50,1),PSJL=$$SETSTR^VALM1(P(2),PSJL,53,7),PSJL=$$SETSTR^VALM1(P(3),PSJL,60,7),PSJL=$$SETSTR^VALM1(P(17),PSJL,67,2)
- +5 ;E S PSJL=$$SETSTR^VALM1(TYP,PSJL,50,1),PSJL=$$SETSTR^VALM1(P(2),53,7),PSJL=$$SETSTR^VALM1(P(3),PSJL,63,7),PSJL=$$SETSTR^VALM1(P(17),PSJL,73,2)
- +6 FOR X=2,3
- SET P(X)=$EXTRACT($$ENDTC2^PSGMI(P(X)),1,$SELECT($DATA(PSJEXTP):8,1:10))
- +7 IF '$DATA(PSJEXTP)
- SET PSJL=$$SETSTR^VALM1(TYP,PSJL,50,1)
- SET PSJL=$$SETSTR^VALM1(P(2),PSJL,53,10)
- SET PSJL=$$SETSTR^VALM1(P(3),PSJL,64,10)
- SET PSJL=$$SETSTR^VALM1(P(17),PSJL,75,2)
- +8 IF '$TEST
- SET PSJL=$$SETSTR^VALM1(TYP,PSJL,50,1)
- SET PSJL=$$SETSTR^VALM1(P(2),53,10)
- SET PSJL=$$SETSTR^VALM1(P(3),PSJL,64,10)
- SET PSJL=$$SETSTR^VALM1(P(17),PSJL,75,2)
- +9 ;373 end
- +10 QUIT
- SETTMP ;
- +1 SET PSJOC(ON,PSJLINE)=PSJL
- SET PSJLINE=PSJLINE+1
- +2 QUIT
- ORDCHK(DFN,TYPE,PIECE) ;
- +1 ;TYPE ="DD" - Duplicate drug
- +2 ; ="DC" - Duplicate class
- +3 ; -"DI" - Drug Interaction
- +4 ;PIECE = The piece order number is return from ^TMP($J,"DD"...
- +5 ;PSJOC(ON,x) = Array of inpatient orders to be displayed
- +6 ;
- +7 NEW ON,PSJL,PSIVX,PSJOC,PSJORIEN,PSJPACK,PSJLINE
- +8 SET PSJOC=0
- SET PSJLINE=1
- +9 FOR PSIVX=0:0
- SET PSIVX=$ORDER(^TMP($JOB,TYPE,PSIVX))
- if 'PSIVX
- QUIT
- Begin DoDot:1
- +10 SET PSJPACK=$PIECE(^TMP($JOB,TYPE,PSIVX,0),U,PIECE)
- +11 ; Set PSJORD if PSGORD exists and is not Null
- IF $GET(PSGORD)
- SET PSJORD=PSGORD
- +12 ; don't flag order that is being renewed as duplicate, only checks Unit Dose orders
- IF $GET(PSJORD)]""
- IF $SELECT($DATA(PSJORD):$GET(PSJORD),1:$GET(PSGORD))'["V"
- IF $PIECE(PSJPACK,";")=$SELECT($DATA(PSJORD):$GET(PSJORD),1:$GET(PSGORD))
- QUIT
- +13 IF $GET(PSJCOM)
- IF ($GET(PSJORD)["P")
- if $DATA(^PS(53.1,"ACX",PSJCOM,+PSJPACK))
- QUIT
- +14 ; Don't flag if pending renewal from CPRS
- +15 IF $GET(PSJORD)]""
- IF (PSJORD["P")
- IF ($PIECE($GET(^PS(53.1,+PSJORD,0)),"^",24)="R")
- IF ($PIECE(PSJPACK,";")["U")
- IF ($PIECE($GET(^PS(55,DFN,5,+$PIECE(PSJPACK,";"),0)),"^",27)="R")
- IF ($PIECE($GET(^PS(55,DFN,5,+$PIECE(PSJPACK,";"),0)),"^",26)=PSJORD)
- QUIT
- +16 ;PSIVRNFG set and kill in R+2^PSIVOPT2. Needed to do dupl. check on new order but not renew.
- IF $GET(PSIVRNFG)
- IF $GET(ON55)["V"
- IF $PIECE(PSJPACK,";")=$GET(ON55)
- QUIT
- +17 SET PSJORIEN=$PIECE(^TMP($JOB,TYPE,PSIVX,0),U,PIECE-1)
- +18 IF TYPE="DI"
- IF ($PIECE(^TMP($JOB,TYPE,PSIVX,0),U,4)="CRITICAL")
- SET PSJIREQ=1
- +19 ; Adding Drug Interactions check for use in Intervention defaults in PSJRXI.
- +20 IF TYPE="DI"
- SET PSJRXREQ=$SELECT($PIECE(^TMP($JOB,TYPE,PSIVX,0),U,4)="CRITICAL":"CRITICAL DRUG INTERACTION",1:"SIGNIFICANT DRUG INTERACTION")
- +21 ;I $P(PSJPACK,";",2)["O" D Q
- +22 NEW X
- SET X=$PIECE(PSJPACK,";",2)
- IF X["O"
- Begin DoDot:2
- +23 if PSJFST=1
- DO PAUSE
- +24 WRITE !!,"The patient has this "_$SELECT($PIECE(PSJPACK,";")["N":"Non-VA Meds",$PIECE(PSJPACK,";",2)["O":"Outpatient",1:"")_" order:",!
- +25 IF $DATA(^TMP($JOB,TYPE,PSIVX,1))
- DO SHOR^PSJLMUT2(TYPE,PSIVX)
- DO PAUSE
- SET PSJFST=$SELECT(PSJFST=0:PSJFST+2,1:PSJFST+1)
- QUIT
- +26 DO EN^PSODRDU2(DFN,PSJPACK,"PSJPRE")
- DO PAUSE
- SET PSJPDRG=1
- SET PSJFST=$SELECT(PSJFST=0:PSJFST+2,1:PSJFST+1)
- End DoDot:2
- QUIT
- +27 SET ON=$PIECE(PSJPACK,";")
- if $DATA(PSJOC(ON))
- QUIT
- +28 IF ON=$GET(PSIVOCON)
- IF +PSJORIEN
- QUIT
- +29 IF ON=$GET(PSIVOCON)
- IF '+PSJORIEN
- DO SETPSJOC
- QUIT
- +30 ;S PSJOC=PSJOC+1,PSJPDRG=1 D:PSJOC=1 WRITE(TYPE)
- +31 IF ON["V"
- Begin DoDot:2
- +32 IF '$ORDER(^PS(55,DFN,"IV",+ON,0))
- DO SETPSJOC
- QUIT
- +33 DO DSPLORDV(DFN,ON)
- SET PSJOC=PSJOC+1
- End DoDot:2
- +34 IF ON'["V"
- DO DSPLORDU(DFN,ON)
- SET PSJOC=PSJOC+1
- +35 SET PSJOC(ON,PSJLINE)=""
- SET PSJLINE=PSJLINE+1
- End DoDot:1
- +36 if PSJOC
- DO WRITE(TYPE)
- +37 SET ON=""
- FOR
- SET ON=$ORDER(PSJOC(ON))
- if ON=""
- QUIT
- WRITE !
- SET PSJLINE=PSJLINE+1
- SET PSJFST=PSJFST+1
- Begin DoDot:1
- +38 FOR PSIVX=0:0
- SET PSIVX=$ORDER(PSJOC(ON,PSIVX))
- if 'PSIVX
- QUIT
- WRITE !,PSJOC(ON,PSIVX)
- SET PSJLINE=PSJLINE+1
- if '(PSIVX#6)
- DO PAUSE
- End DoDot:1
- +39 WRITE !
- +40 QUIT
- SETPSJOC ;Set PSJOC array to be displayed later
- +1 NEW PIECE
- SET PIECE=$SELECT(TYPE="DC":4,1:2)
- +2 SET X=$$SETSTR^VALM1($PIECE(^TMP($JOB,TYPE,PSIVX,0),U,PIECE),"",9,40)
- +3 SET X=$$SETSTR^VALM1("* EXISTS IN CURRENT ORDER *",X,50,27)
- +4 SET PSJOC(ON,PSJLINE)=X
- SET PSJLINE=PSJLINE+1
- SET PSJOC=PSJOC+1
- +5 QUIT
- WRITE(TYPE) ;Display order check description
- +1 SET PSJPDRG=1
- +2 IF TYPE="DD"
- WRITE !!,"This patient is already receiving the following order",$SELECT(PSJOC>1:"s",1:"")," for ",$SELECT($GET(PSJDD)]"":$PIECE($GET(^PSDRUG(PSJDD,0)),U),1:"this drug"),":",!
- +3 IF TYPE="DC"
- WRITE !!,"This patient is already receiving ",$SELECT(PSJOC>1:"orders",1:"an order")," for the following drug",$SELECT(PSJOC>1:"s",1:"")," in the same",!,"class as ",$SELECT($GET(PSJDD)]"":$PIECE($GET(^PSDRUG(PSJDD,0)),U),1:"the drug select
- ed"),":",!
- +4 IF TYPE="DI"
- WRITE !!,"This patient is receiving the following medication",$SELECT(PSJOC>1:"s",1:"")," that ha",$SELECT(PSJOC>1:"ve",1:"s")," an interaction",!,"with ",$PIECE($GET(^PSDRUG(PSJDD,0)),U),":",!
- +5 QUIT
- PAUSE ;
- +1 KILL DIR
- WRITE !
- SET DIR(0)="EA"
- SET DIR("A")="Press Return to continue..."
- DO ^DIR
- WRITE !
- +2 QUIT