- Timestamp:
- Dec 4, 2009, 8:26:01 PM (14 years ago)
- Location:
- FOIAVistA/tag/r
- Files:
-
- 1 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
FOIAVistA/tag/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJLMUT1.m
r628 r636 1 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 22 ;;5.0; INPATIENT MEDICATIONS ;**4,27,29,49,58,107,110,146,175**;16 DEC 97;Build 18 3 3 ; 4 4 ; Reference to ^PS(55 is supported by DBIA# 2191. … … 25 25 I +$O(@(F_"1,0)")),'+$O(@(F_"1,1)")),PSGUPDDO="" D DD(F,.DRUGNAME) 26 26 S:($G(DRUGNAME)=""!($G(DRUGNAME)["NOT FOUND")) DRUGNAME=$$OIDF(OIND) 27 ;S PSGGV=$S(NOTGV:"*** NOT TO BE GIVEN *** ",1:"")_PSGINS_PSGUPDDO_" "_MR_" "_SCH28 27 S PSGGV=$S(NOTGV:"*** NOT TO BE GIVEN *** ",1:"")_$S(('$D(PSJPDDDP)&('$L(PSGUPDDO))):PSGINS,1:PSGUPDDO)_" "_MR_" "_SCH 29 28 S PSGX=0 K PSJPDDDP … … 34 33 . S NAME(PSGX+X)=$S(X>1:" ",1:"")_MARX(X) 35 34 Q 35 ; 36 36 OIDF(OIND) ; Return Orderable Item name and Dosage form. 37 37 ;; +OIND = orderable item IEN … … 50 50 S PSJPDDDP=1 51 51 Q 52 ; 52 53 DSPLORDU(PSGP,ON) ; Display UD order for order check as in the Inpat Profile. 53 54 NEW DRUGNAME,F,NODE0,NODE2,PSJID,PSJX,SCH,SD,STAT,X,Y … … 66 67 . S PSJLINE=PSJLINE+1 67 68 Q 69 ; 68 70 DSPLORDV(DFN,ON) ; Display IV order for order check as in the Inpat Profile. 69 N DRG,DRGI,DRGT,DRGX,FIL,ND,ON55,P,PSJ IVFLG,PSJORIFN,TYP,X,Y71 N DRG,DRGI,DRGT,DRGX,FIL,ND,ON55,P,PSJCT,PSJIVFLG,PSJORIFN,TYP,X,Y 70 72 S TYP="?" I ON["V" D 71 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) … … 76 78 S PSJIVFLG=1 D PIVAD,SOL 77 79 Q 80 ; 78 81 SOL ; 79 82 S PSJL=$S($G(PSJIVFLG):PSJL,1:"")_" in" 80 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=" " 81 84 Q 85 ; 82 86 PIVAD ; Print IV Additives. 83 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 … … 90 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) 91 95 Q 96 ; 92 97 SETTMP ; 93 98 S PSJOC(ON,PSJLINE)=PSJL,PSJLINE=PSJLINE+1 94 99 Q 100 ; 95 101 ORDCHK(DFN,TYPE,PIECE) ; 96 102 ;TYPE ="DD" - Duplicate drug … … 114 120 . ; Adding Drug Interactions check for use in Intervention defaults in PSJRXI. 115 121 . 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 Q117 122 . N X S X=$P(PSJPACK,";",2) I X["O" D Q 118 123 .. D:PSJFST=1 PAUSE … … 123 128 . I ON=$G(PSIVOCON),+PSJORIEN Q 124 129 . I ON=$G(PSIVOCON),'+PSJORIEN D SETPSJOC Q 125 . ;S PSJOC=PSJOC+1,PSJPDRG=1 D:PSJOC=1 WRITE(TYPE)126 130 . I ON["V" D 127 131 .. I '$O(^PS(55,DFN,"IV",+ON,0)) D SETPSJOC Q … … 129 133 . I ON'["V" D DSPLORDU(DFN,ON) S PSJOC=PSJOC+1 130 134 . 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 ; 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 135 151 Q 152 ; 136 153 SETPSJOC ;Set PSJOC array to be displayed later 137 154 NEW PIECE S PIECE=$S(TYPE="DC":4,1:2) … … 140 157 S PSJOC(ON,PSJLINE)=X,PSJLINE=PSJLINE+1,PSJOC=PSJOC+1 141 158 Q 159 ; 142 160 WRITE(TYPE) ;Display order check description 143 161 S PSJPDRG=1 … … 146 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),":",! 147 165 Q 166 ; 148 167 PAUSE ; 149 168 K DIR W ! S DIR(0)="EA",DIR("A")="Press Return to continue..." D ^DIR W !
Note:
See TracChangeset
for help on using the changeset viewer.