- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJLMUT1.m
r613 r623 1 PSJLMUT1 ;BIR/MLM-DRUG NAME DISPLAY ;05 Feb 98 / 1:39 PM 2 ;;5.0; INPATIENT MEDICATIONS ;**4,27,29,49,58,107,110,146,175,201**;16 DEC 97;Build 2 3 ; 4 ; Reference to ^PS(55 is supported by DBIA# 2191. 5 ; Reference to ^PS(50.7 is supported by DBIA# 2180. 6 ; Reference to ^PS(50.606 is supported by DBIA# 2174. 7 ; Reference to EN^PSODRDU2 is supported by DBIA# 2189. 8 ; Reference to ^PSDRUG( is supported by DBIA 2192. 9 ; 10 DRGDISP(DFN,ON,NL,GL,NAME,DRUGONLY) ; 11 ;; DRUGONLY = 1/0 - Only the drug name will be returned. 12 ;; NL = The drug name display length 13 ;; GL = The give line display length, total length-6 ("Give: ") 14 ;; NAME(X) = Drug name and give line in displayable format. 15 ;; ON = IEN#_U/P (U=Unit Dose; P=Pending) 16 ; 17 NEW F,OIND,MARX,MR,NOTGV,SCH,PSGUPDDO,PSGGV,X,PSGX,PSGINS,DRUGNAME 18 K NAME S PSGINS="" 19 S:ON["U" F="^PS(55,DFN,5,+ON," 20 I ON["P" S F="^PS(53.1,+ON,",X=$G(@(F_".3)")),PSGINS=$S(X]"":X,1:"") 21 I $G(@(F_"0)"))="" S NAME(1)="NOT FOUND" Q 22 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)) 23 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 24 S SCH=$P($G(@(F_"2)")),U) 25 I +$O(@(F_"1,0)")),'+$O(@(F_"1,1)")),PSGUPDDO="" D DD(F,.DRUGNAME) 26 S:($G(DRUGNAME)=""!($G(DRUGNAME)["NOT FOUND")) DRUGNAME=$$OIDF(OIND) 27 ;S PSGGV=$S(NOTGV:"*** NOT TO BE GIVEN *** ",1:"")_PSGINS_PSGUPDDO_" "_MR_" "_SCH 28 S PSGGV=$S(NOTGV:"*** NOT TO BE GIVEN *** ",1:"")_$S(('$D(PSJPDDDP)&('$L(PSGUPDDO))):PSGINS,1:PSGUPDDO)_" "_MR_" "_SCH 29 S PSGX=0 K PSJPDDDP 30 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 31 Q:+DRUGONLY 32 D TXT^PSGMUTL(PSGGV,GL) F X=0:0 S X=$O(MARX(X)) Q:'X D 33 . I X=1 S NAME(PSGX+X)="Give: "_MARX(X) Q 34 . S NAME(PSGX+X)=$S(X>1:" ",1:"")_MARX(X) 35 Q 36 OIDF(OIND) ; Return Orderable Item name and Dosage form. 37 ;; +OIND = orderable item IEN 38 NEW X,NAME 39 S X=$G(^PS(50.7,+OIND,0)) 40 S:$P(X,U)]"" NAME=$P(X,U)_" "_$P($G(^PS(50.606,+$P(X,U,2),0)),U) 41 Q $S($G(NAME)]"":NAME,1:"NOT FOUND "_+OIND_";PS(50.7") 42 ; 43 DD(F,NAME) ; Return Dispense drug name. 44 ;; F = "^PS(55,DFN,5,+ON," or "^PS(53.1,+ON," 45 NEW X K NAME 46 S X=$O(@(F_"1,0)")),X=$G(@(F_"1,"_+X_",0)")) 47 I $P(X,U)]"" S NAME=$P($G(^PSDRUG(+X,0)),U) 48 E S NAME="NOT FOUND "_+X_";PSDRUG" 49 I '$O(@(F_"1,1)")),+$P(X,U,2)>1 S PSGUPDDO=+$P(X,U,2) 50 S PSJPDDDP=1 51 Q 52 DSPLORDU(PSGP,ON) ; Display UD order for order check as in the Inpat Profile. 53 NEW DRUGNAME,F,NODE0,NODE2,PSJID,PSJX,SCH,SD,STAT,X,Y 54 S F=$S(ON["U":"^PS(55,PSGP,5,"_+ON_",",1:"^PS(53.1,"_+ON_",") 55 S NODE0=$G(@(F_"0)")),NODE2=$G(@(F_"2)")) 56 D DRGDISP^PSJLMUT1(PSGP,ON,39,54,.DRUGNAME,0) 57 I ON["P",$P(NODE0,U,4)="F" D DSPLORDV(PSGP,ON) Q 58 S SCH=$P(NODE0,U,7) 59 S STAT=$P(NODE0,U,9) I STAT="A",$P(NODE0,U,27)="R" S STAT="R" 60 I STAT'="P" S PSJID=$E($$ENDTC^PSGMI($P(NODE2,U,2)),1,5),SD=$E($$ENDTC^PSGMI($P(NODE2,U,4)),1,5) 61 I STAT="P" S (PSJID,SD)="*****",SCH="?" 62 F PSJX=0:0 S PSJX=$O(DRUGNAME(PSJX)) Q:'PSJX D 63 . S:PSJX=1 X=SCH_" "_PSJID_" "_SD_" "_$E(STAT,1) 64 . S:PSJX=1 DRUGNAME(1)=$$SETSTR^VALM1(X,$E(DRUGNAME(1),1,40),42,20) 65 . S PSJOC(ON,PSJLINE)=" "_DRUGNAME(PSJX) 66 . S PSJLINE=PSJLINE+1 67 Q 68 DSPLORDV(DFN,ON) ; Display IV order for order check as in the Inpat Profile. 69 N DRG,DRGI,DRGT,DRGX,FIL,ND,ON55,P,PSJIVFLG,PSJORIFN,TYP,X,Y 70 S TYP="?" I ON["V" D 71 .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) 72 .S TYP=$$ONE^PSJBCMA(DFN,ON,P(9),P(2),P(3)) I TYP'="O" S TYP="C" 73 .S ON55=ON,P("OT")=$S(P(4)="A":"F",P(4)="H":"H",1:"I") D GTDRG^PSIVORFB,GTOT^PSIVUTL(P(4)) 74 S PSJCT=0,PSJL="" 75 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)) 76 S PSJIVFLG=1 D PIVAD,SOL 77 Q 78 SOL ; 79 S PSJL=$S($G(PSJIVFLG):PSJL,1:"")_" in" 80 S DRG=0 F S DRG=+$O(DRG("SOL",DRG)) Q:'DRG D NAME^PSIVUTL(DRG("SOL",DRG),39,.NAME,0) S DRGX=0 F S DRGX=$O(NAME(DRGX)) Q:'DRGX S PSJL=$$SETSTR^VALM1(NAME(DRGX),PSJL,12,60) D:$G(PSJIVFLG) PIV1 D SETTMP S PSJL=" " 81 Q 82 PIVAD ; Print IV Additives. 83 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 S PSJL=$$SETSTR^VALM1(NAME(DRGX),PSJL,9,60) D:$G(PSJIVFLG) PIV1 D SETTMP 84 Q 85 ; 86 PIV1 ; Print Sched type, start/stop dates, and status. 87 K PSJIVFLG 88 F X=2,3 S P(X)=$E($$ENDTC^PSGMI(P(X)),1,$S($D(PSJEXTP):8,1:5)) 89 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,1) 90 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,1) 91 Q 92 SETTMP ; 93 S PSJOC(ON,PSJLINE)=PSJL,PSJLINE=PSJLINE+1 94 Q 95 ORDCHK(DFN,TYPE,PIECE) ; 96 ;TYPE ="DD" - Duplicate drug 97 ; ="DC" - Duplicate class 98 ; -"DI" - Drug Interaction 99 ;PIECE = The piece order number is return from ^TMP($J,"DD"... 100 ;PSJOC(ON,x) = Array of inpatient orders to be displayed 101 ; 102 NEW ON,PSJL,PSIVX,PSJOC,PSJORIEN,PSJPACK,PSJLINE 103 S PSJOC=0,PSJLINE=1 104 F PSIVX=0:0 S PSIVX=$O(^TMP($J,TYPE,PSIVX)) Q:'PSIVX D 105 . S PSJPACK=$P(^TMP($J,TYPE,PSIVX,0),U,PIECE) 106 . I $G(PSGORD) S PSJORD=PSGORD ; Set PSJORD if PSGORD exists and is not Null 107 . 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 108 . I $G(PSJCOM),($G(PSJORD)["P") Q:$D(^PS(53.1,"ACX",PSJCOM,+PSJPACK)) 109 . ; Don't flag if pending renewal from CPRS 110 . 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 111 . 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. 112 . S PSJORIEN=$P(^TMP($J,TYPE,PSIVX,0),U,PIECE-1) 113 . I TYPE="DI",($P(^TMP($J,TYPE,PSIVX,0),U,4)="CRITICAL") S PSJIREQ=1 114 . ; Adding Drug Interactions check for use in Intervention defaults in PSJRXI. 115 . I TYPE="DI" S PSJRXREQ=$S($P(^TMP($J,TYPE,PSIVX,0),U,4)="CRITICAL":1,1:2) 116 . ;I $P(PSJPACK,";",2)["O" D Q 117 . N X S X=$P(PSJPACK,";",2) I X["O" D Q 118 .. D:PSJFST=1 PAUSE 119 .. W !!,"The patient has this "_$S($P(PSJPACK,";")["N":"Non-VA Meds",$P(PSJPACK,";",2)["O":"Outpatient",1:"")_" order:",! 120 .. I $D(^TMP($J,TYPE,PSIVX,1)) D SHOR^PSJLMUT2(TYPE,PSIVX),PAUSE S PSJFST=$S(PSJFST=0:PSJFST+2,1:PSJFST+1) Q 121 .. D EN^PSODRDU2(DFN,PSJPACK),PAUSE S PSJPDRG=1,PSJFST=$S(PSJFST=0:PSJFST+2,1:PSJFST+1) 122 . S ON=$P(PSJPACK,";") Q:$D(PSJOC(ON)) 123 . I ON=$G(PSIVOCON),+PSJORIEN Q 124 . I ON=$G(PSIVOCON),'+PSJORIEN D SETPSJOC Q 125 . ;S PSJOC=PSJOC+1,PSJPDRG=1 D:PSJOC=1 WRITE(TYPE) 126 . I ON["V" D 127 .. I '$O(^PS(55,DFN,"IV",+ON,0)) D SETPSJOC Q 128 .. D DSPLORDV(DFN,ON) S PSJOC=PSJOC+1 129 . I ON'["V" D DSPLORDU(DFN,ON) S PSJOC=PSJOC+1 130 . S PSJOC(ON,PSJLINE)="",PSJLINE=PSJLINE+1 131 D:PSJOC WRITE(TYPE) 132 S ON="" F S ON=$O(PSJOC(ON)) Q:ON="" W ! S PSJLINE=PSJLINE+1,PSJFST=PSJFST+1 D 133 . F PSIVX=0:0 S PSIVX=$O(PSJOC(ON,PSIVX)) Q:'PSIVX W !,PSJOC(ON,PSIVX) S PSJLINE=PSJLINE+1 D:'(PSIVX#6) PAUSE 134 W ! 135 Q 136 SETPSJOC ;Set PSJOC array to be displayed later 137 NEW PIECE S PIECE=$S(TYPE="DC":4,1:2) 138 S X=$$SETSTR^VALM1($P(^TMP($J,TYPE,PSIVX,0),U,PIECE),"",9,40) 139 S X=$$SETSTR^VALM1("* EXISTS IN CURRENT ORDER *",X,50,27) 140 S PSJOC(ON,PSJLINE)=X,PSJLINE=PSJLINE+1,PSJOC=PSJOC+1 141 Q 142 WRITE(TYPE) ;Display order check description 143 S PSJPDRG=1 144 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"),":",! 145 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"),":",! 146 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),":",! 147 Q 148 PAUSE ; 149 K DIR W ! S DIR(0)="EA",DIR("A")="Press Return to continue..." D ^DIR W ! 150 Q 1 PSJLMUT1 ;BIR/MLM-DRUG NAME DISPLAY ;05 Feb 98 / 1:39 PM 2 ;;5.0; INPATIENT MEDICATIONS ;**4,27,29,49,58,107,110,146,175**;16 DEC 97;Build 18 3 ; 4 ; Reference to ^PS(55 is supported by DBIA# 2191. 5 ; Reference to ^PS(50.7 is supported by DBIA# 2180. 6 ; Reference to ^PS(50.606 is supported by DBIA# 2174. 7 ; Reference to EN^PSODRDU2 is supported by DBIA# 2189. 8 ; Reference to ^PSDRUG( is supported by DBIA 2192. 9 ; 10 DRGDISP(DFN,ON,NL,GL,NAME,DRUGONLY) ; 11 ;; DRUGONLY = 1/0 - Only the drug name will be returned. 12 ;; NL = The drug name display length 13 ;; GL = The give line display length, total length-6 ("Give: ") 14 ;; NAME(X) = Drug name and give line in displayable format. 15 ;; ON = IEN#_U/P (U=Unit Dose; P=Pending) 16 ; 17 NEW F,OIND,MARX,MR,NOTGV,SCH,PSGUPDDO,PSGGV,X,PSGX,PSGINS,DRUGNAME 18 K NAME S PSGINS="" 19 S:ON["U" F="^PS(55,DFN,5,+ON," 20 I ON["P" S F="^PS(53.1,+ON,",X=$G(@(F_".3)")),PSGINS=$S(X]"":X,1:"") 21 I $G(@(F_"0)"))="" S NAME(1)="NOT FOUND" Q 22 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)) 23 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 24 S SCH=$P($G(@(F_"2)")),U) 25 I +$O(@(F_"1,0)")),'+$O(@(F_"1,1)")),PSGUPDDO="" D DD(F,.DRUGNAME) 26 S:($G(DRUGNAME)=""!($G(DRUGNAME)["NOT FOUND")) DRUGNAME=$$OIDF(OIND) 27 S PSGGV=$S(NOTGV:"*** NOT TO BE GIVEN *** ",1:"")_$S(('$D(PSJPDDDP)&('$L(PSGUPDDO))):PSGINS,1:PSGUPDDO)_" "_MR_" "_SCH 28 S PSGX=0 K PSJPDDDP 29 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 30 Q:+DRUGONLY 31 D TXT^PSGMUTL(PSGGV,GL) F X=0:0 S X=$O(MARX(X)) Q:'X D 32 . I X=1 S NAME(PSGX+X)="Give: "_MARX(X) Q 33 . S NAME(PSGX+X)=$S(X>1:" ",1:"")_MARX(X) 34 Q 35 ; 36 OIDF(OIND) ; Return Orderable Item name and Dosage form. 37 ;; +OIND = orderable item IEN 38 NEW X,NAME 39 S X=$G(^PS(50.7,+OIND,0)) 40 S:$P(X,U)]"" NAME=$P(X,U)_" "_$P($G(^PS(50.606,+$P(X,U,2),0)),U) 41 Q $S($G(NAME)]"":NAME,1:"NOT FOUND "_+OIND_";PS(50.7") 42 ; 43 DD(F,NAME) ; Return Dispense drug name. 44 ;; F = "^PS(55,DFN,5,+ON," or "^PS(53.1,+ON," 45 NEW X K NAME 46 S X=$O(@(F_"1,0)")),X=$G(@(F_"1,"_+X_",0)")) 47 I $P(X,U)]"" S NAME=$P($G(^PSDRUG(+X,0)),U) 48 E S NAME="NOT FOUND "_+X_";PSDRUG" 49 I '$O(@(F_"1,1)")),+$P(X,U,2)>1 S PSGUPDDO=+$P(X,U,2) 50 S PSJPDDDP=1 51 Q 52 ; 53 DSPLORDU(PSGP,ON) ; Display UD order for order check as in the Inpat Profile. 54 NEW DRUGNAME,F,NODE0,NODE2,PSJID,PSJX,SCH,SD,STAT,X,Y 55 S F=$S(ON["U":"^PS(55,PSGP,5,"_+ON_",",1:"^PS(53.1,"_+ON_",") 56 S NODE0=$G(@(F_"0)")),NODE2=$G(@(F_"2)")) 57 D DRGDISP^PSJLMUT1(PSGP,ON,39,54,.DRUGNAME,0) 58 I ON["P",$P(NODE0,U,4)="F" D DSPLORDV(PSGP,ON) Q 59 S SCH=$P(NODE0,U,7) 60 S STAT=$P(NODE0,U,9) I STAT="A",$P(NODE0,U,27)="R" S STAT="R" 61 I STAT'="P" S PSJID=$E($$ENDTC^PSGMI($P(NODE2,U,2)),1,5),SD=$E($$ENDTC^PSGMI($P(NODE2,U,4)),1,5) 62 I STAT="P" S (PSJID,SD)="*****",SCH="?" 63 F PSJX=0:0 S PSJX=$O(DRUGNAME(PSJX)) Q:'PSJX D 64 . S:PSJX=1 X=SCH_" "_PSJID_" "_SD_" "_$E(STAT,1) 65 . S:PSJX=1 DRUGNAME(1)=$$SETSTR^VALM1(X,$E(DRUGNAME(1),1,40),42,20) 66 . S PSJOC(ON,PSJLINE)=" "_DRUGNAME(PSJX) 67 . S PSJLINE=PSJLINE+1 68 Q 69 ; 70 DSPLORDV(DFN,ON) ; Display IV order for order check as in the Inpat Profile. 71 N DRG,DRGI,DRGT,DRGX,FIL,ND,ON55,P,PSJCT,PSJIVFLG,PSJORIFN,TYP,X,Y 72 S TYP="?" I ON["V" D 73 .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) 74 .S TYP=$$ONE^PSJBCMA(DFN,ON,P(9),P(2),P(3)) I TYP'="O" S TYP="C" 75 .S ON55=ON,P("OT")=$S(P(4)="A":"F",P(4)="H":"H",1:"I") D GTDRG^PSIVORFB,GTOT^PSIVUTL(P(4)) 76 S PSJCT=0,PSJL="" 77 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)) 78 S PSJIVFLG=1 D PIVAD,SOL 79 Q 80 ; 81 SOL ; 82 S PSJL=$S($G(PSJIVFLG):PSJL,1:"")_" in" 83 S DRG=0 F S DRG=+$O(DRG("SOL",DRG)) Q:'DRG D NAME^PSIVUTL(DRG("SOL",DRG),39,.NAME,0) S DRGX=0 F S DRGX=$O(NAME(DRGX)) Q:'DRGX S PSJL=$$SETSTR^VALM1(NAME(DRGX),PSJL,12,60) D:$G(PSJIVFLG) PIV1 D SETTMP S PSJL=" " 84 Q 85 ; 86 PIVAD ; Print IV Additives. 87 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 S PSJL=$$SETSTR^VALM1(NAME(DRGX),PSJL,9,60) D:$G(PSJIVFLG) PIV1 D SETTMP 88 Q 89 ; 90 PIV1 ; Print Sched type, start/stop dates, and status. 91 K PSJIVFLG 92 F X=2,3 S P(X)=$E($$ENDTC^PSGMI(P(X)),1,$S($D(PSJEXTP):8,1:5)) 93 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,1) 94 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,1) 95 Q 96 ; 97 SETTMP ; 98 S PSJOC(ON,PSJLINE)=PSJL,PSJLINE=PSJLINE+1 99 Q 100 ; 101 ORDCHK(DFN,TYPE,PIECE) ; 102 ;TYPE ="DD" - Duplicate drug 103 ; ="DC" - Duplicate class 104 ; -"DI" - Drug Interaction 105 ;PIECE = The piece order number is return from ^TMP($J,"DD"... 106 ;PSJOC(ON,x) = Array of inpatient orders to be displayed 107 ; 108 NEW ON,PSJL,PSIVX,PSJOC,PSJORIEN,PSJPACK,PSJLINE 109 S PSJOC=0,PSJLINE=1 110 F PSIVX=0:0 S PSIVX=$O(^TMP($J,TYPE,PSIVX)) Q:'PSIVX D 111 . S PSJPACK=$P(^TMP($J,TYPE,PSIVX,0),U,PIECE) 112 . I $G(PSGORD) S PSJORD=PSGORD ; Set PSJORD if PSGORD exists and is not Null 113 . 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 114 . I $G(PSJCOM),($G(PSJORD)["P") Q:$D(^PS(53.1,"ACX",PSJCOM,+PSJPACK)) 115 . ; Don't flag if pending renewal from CPRS 116 . 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 117 . 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. 118 . S PSJORIEN=$P(^TMP($J,TYPE,PSIVX,0),U,PIECE-1) 119 . I TYPE="DI",($P(^TMP($J,TYPE,PSIVX,0),U,4)="CRITICAL") S PSJIREQ=1 120 . ; Adding Drug Interactions check for use in Intervention defaults in PSJRXI. 121 . I TYPE="DI" S PSJRXREQ=$S($P(^TMP($J,TYPE,PSIVX,0),U,4)="CRITICAL":1,1:2) 122 . N X S X=$P(PSJPACK,";",2) I X["O" D Q 123 .. D:PSJFST=1 PAUSE 124 .. W !!,"The patient has this "_$S($P(PSJPACK,";")["N":"Non-VA Meds",$P(PSJPACK,";",2)["O":"Outpatient",1:"")_" order:",! 125 .. I $D(^TMP($J,TYPE,PSIVX,1)) D SHOR^PSJLMUT2(TYPE,PSIVX),PAUSE S PSJFST=$S(PSJFST=0:PSJFST+2,1:PSJFST+1) Q 126 .. D EN^PSODRDU2(DFN,PSJPACK),PAUSE S PSJPDRG=1,PSJFST=$S(PSJFST=0:PSJFST+2,1:PSJFST+1) 127 . S ON=$P(PSJPACK,";") Q:$D(PSJOC(ON)) 128 . I ON=$G(PSIVOCON),+PSJORIEN Q 129 . I ON=$G(PSIVOCON),'+PSJORIEN D SETPSJOC Q 130 . I ON["V" D 131 .. I '$O(^PS(55,DFN,"IV",+ON,0)) D SETPSJOC Q 132 .. D DSPLORDV(DFN,ON) S PSJOC=PSJOC+1 133 . I ON'["V" D DSPLORDU(DFN,ON) S PSJOC=PSJOC+1 134 . S PSJOC(ON,PSJLINE)="",PSJLINE=PSJLINE+1 135 ; DEM - If TYPE="DI", and there are "DI" orders, 136 ; then display "DI" orders. 137 I TYPE="DI",PSJOC D WRITE(TYPE) D ;DEM 138 . S ON="" F S ON=$O(PSJOC(ON)) Q:ON="" S PSJLINE=PSJLINE+1,PSJFST=PSJFST+1 D ;DEM 139 .. F PSIVX=0:0 S PSIVX=$O(PSJOC(ON,PSIVX)) Q:'PSIVX W !,PSJOC(ON,PSIVX) S PSJLINE=PSJLINE+1 ;DEM 140 Q:(TYPE="DI") ;DEM - Don't continue if TYPE="DI". Code that follows is for TYPEs "DD" and "DC" only. 141 Q:'PSJOC ;DEM - No need to continue if no "DD", or "DC" orders. 142 ; DEM - If we are here, then there are "DD", or "DC" orders in 143 ; PSJOC array. Loop on PSJOC array and set orders into 144 ; ^TMP($J,"DUPDRG",TYPE) global. The ^TMP($J,"DUPDRG",TYPE) 145 ; global will be used for display of "DD" and "DC" orders 146 ; for possible discontinuation of the "DD", or "DC" orders. 147 ; See subroutine DUPDRG and calling routine ENDDC^PSGSICHK 148 ; for details. 149 S ON="" F S ON=$O(PSJOC(ON)) Q:ON="" D ;DEM 150 . F PSIVX=0:0 S PSIVX=$O(PSJOC(ON,PSIVX)) Q:'PSIVX S ^TMP($J,"DUPDRG",TYPE,ON,PSIVX)=PSJOC(ON,PSIVX) ;DEM 151 Q 152 ; 153 SETPSJOC ;Set PSJOC array to be displayed later 154 NEW PIECE S PIECE=$S(TYPE="DC":4,1:2) 155 S X=$$SETSTR^VALM1($P(^TMP($J,TYPE,PSIVX,0),U,PIECE),"",9,40) 156 S X=$$SETSTR^VALM1("* EXISTS IN CURRENT ORDER *",X,50,27) 157 S PSJOC(ON,PSJLINE)=X,PSJLINE=PSJLINE+1,PSJOC=PSJOC+1 158 Q 159 ; 160 WRITE(TYPE) ;Display order check description 161 S PSJPDRG=1 162 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"),":",! 163 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"),":",! 164 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),":",! 165 Q 166 ; 167 PAUSE ; 168 K DIR W ! S DIR(0)="EA",DIR("A")="Press Return to continue..." D ^DIR W ! 169 Q
Note:
See TracChangeset
for help on using the changeset viewer.
