| 1 | PSJORUT2 ;BIR/MLM-MISC. PROCEDURE CALLS FOR OE/RR 3.0 (CONT.) ;03 Aug 98 / 8:42 AM
|
|---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;**14,29,50,56,58,107,152**;16 DEC 97
|
|---|
| 3 | ;
|
|---|
| 4 | ; Reference to ^PS(55 is supported by DBIA 2191
|
|---|
| 5 | ; Reference to ^PS(50.605 is supported by DBIA 2138
|
|---|
| 6 | ; References to ^PS(52.6 supported by DBIA 1231
|
|---|
| 7 | ; Reference to ^PS(52.7 supported by DBIA 2173.
|
|---|
| 8 | ; Reference to ^PSDRUG( is supported by DBIA 2192
|
|---|
| 9 | ; Reference to ^PSNDF( is supported by DBIA 2195
|
|---|
| 10 | ; Reference to ^PSRX( is supported by DBIA 824
|
|---|
| 11 | ; Reference to ^PSNAPIS is supported by DBIA 2531
|
|---|
| 12 | ;
|
|---|
| 13 | ENVAC(PN) ; Find VA CLASS of VA Product Name
|
|---|
| 14 | ;Input: PN - See above
|
|---|
| 15 | ;Output: VA Drug Class^Classification
|
|---|
| 16 | ;
|
|---|
| 17 | ; NEW NDF CALL
|
|---|
| 18 | N X S X="PSNAPIS" X ^%ZOSF("TEST") I N PSJC,X1,X2 S X1=+$P(PN,"."),X2=+$P(PN,".",2),PSJC=$$DCLASS^PSNAPIS(X1,X2) Q PSJC
|
|---|
| 19 | ;
|
|---|
| 20 | N GDP,PNP S GDP=$P(PN,"."),PNP=$P(PN,".",2)
|
|---|
| 21 | S X=+$P($G(^PSNDF(+GDP,5,+PNP,0)),U,2),X=+$P($G(^PSNDF(GDP,2,X,0)),U,3),PSJC=$P($G(^PS(50.605,X,0)),U,2)
|
|---|
| 22 | Q $S('X:0,PSJC="":0,1:X_U_PSJC)
|
|---|
| 23 | ;
|
|---|
| 24 | ENVAGN(PN) ; Return VA Generic Name for specified VA Product Name.
|
|---|
| 25 | ;Input: PN - VA Product Name IEN
|
|---|
| 26 | ;Output: VA Generic Name IEN^VA Generic Name
|
|---|
| 27 | ;
|
|---|
| 28 | ; NEW NDF CALL
|
|---|
| 29 | N X S X="PSNAPIS" X ^%ZOSF("TEST") I N GDP,X1,X2 S X1=+$P(PN,"."),X2=+$P(PN,".",2),GDP=$$VAGN^PSNAPIS(X1) Q $S(GDP=0:0,1:X1_U_GDP)
|
|---|
| 30 | ;
|
|---|
| 31 | N GDP,PNP S GDP=+$P(PN,"."),PNP=+$P(PN,".",2)
|
|---|
| 32 | S X=$P($G(^PSNDF(GDP,0)),U)
|
|---|
| 33 | Q $S('GDP:0,X="":0,1:GDP_U_X)
|
|---|
| 34 | ENVOL(PN,ARRAY) ;
|
|---|
| 35 | I (PN'["A")&(PN'["B") S ARRAY="0" Q
|
|---|
| 36 | N X,XX,F,INACT,IVFL S X(1)="ML",X(2)="LITER",X(3)="MCG",X(4)="MG",X(5)="GM",X(6)="UNITS",X(7)="IU",X(8)="MEQ",X(9)="MM",X(10)="MU",X(11)="THOUU",X(12)="MG-PE",X(13)="NANOGRAM"
|
|---|
| 37 | I PN["A" N ADD S (ADD,X,XX)=0 F S ADD=$O(^PS(52.6,"AOI",+PN,ADD)) Q:ADD="" D
|
|---|
| 38 | .S INACT=$G(^PS(52.6,ADD,"I")) I INACT']""!(INACT>DT) S IVFL=$P($G(^(0)),"^",13) Q:'IVFL S XX=XX+1,ARRAY(ADD)="^"_X($P($G(^PS(52.6,ADD,0)),U,3)) Q
|
|---|
| 39 | I PN["B" N SOL S SOL=0,XX=0 F S SOL=$O(^PS(52.7,"AOI",+PN,SOL)) Q:SOL="" D
|
|---|
| 40 | .S INACT=$G(^PS(52.7,SOL,"I")) I INACT']""!(INACT>DT) S IVFL=$P($G(^(0)),"^",13) Q:'IVFL S XX=XX+1,ARRAY(SOL)=$P($G(^PS(52.7,SOL,0)),"^",3)
|
|---|
| 41 | S ARRAY=XX>0
|
|---|
| 42 | Q
|
|---|
| 43 | ;
|
|---|
| 44 | ENVOL2(PN,ARRAY) ;Only for Med Button IV orders.
|
|---|
| 45 | I (PN'["A")&(PN'["B") S ARRAY="0" Q
|
|---|
| 46 | N X,XX,F,INACT S X(1)="ML",X(2)="LITER",X(3)="MCG",X(4)="MG",X(5)="GM",X(6)="UNITS",X(7)="IU",X(8)="MEQ",X(9)="MM",X(10)="MU",X(11)="THOUU",X(12)="MG-PE",X(13)="NANOGRAM"
|
|---|
| 47 | I PN["A" N ADD S (ADD,X,XX)=0 F S ADD=$O(^PS(52.6,"AOI",+PN,ADD)) Q:ADD="" D
|
|---|
| 48 | .S INACT=$G(^PS(52.6,ADD,"I")) I INACT']""!(INACT>DT) S XX=XX+1,ARRAY(ADD)="^"_X($P($G(^PS(52.6,ADD,0)),U,3)) Q
|
|---|
| 49 | I PN["B" N SOL S SOL=0,XX=0 F S SOL=$O(^PS(52.7,"AOI",+PN,SOL)) Q:SOL="" D
|
|---|
| 50 | .S INACT=$G(^PS(52.7,SOL,"I")) I INACT']""!(INACT>DT) S XX=XX+1,ARRAY(SOL)=$P($G(^PS(52.7,SOL,0)),"^",3)
|
|---|
| 51 | S ARRAY=XX>0
|
|---|
| 52 | Q
|
|---|
| 53 | ;
|
|---|
| 54 | ;
|
|---|
| 55 | SENVOL(PN,PSJ) ;Return array listing volume (base only) and volume units for the specified additive or solution.
|
|---|
| 56 | ;Input: PN - IEN_B (Base) or A (Additive)
|
|---|
| 57 | ;Output: ARRAY(IEN,A:additive or B:Base)=volume^volume units
|
|---|
| 58 | ; If no volume or units found PSJ=0; If found PSJ=1.
|
|---|
| 59 | ;
|
|---|
| 60 | N X S PSJ=1,X(1)="ML",X(2)="LITER",X(3)="MCG",X(4)="MG",X(5)="GM",X(6)="UNITS",X(7)="IU",X(8)="MEQ",X(9)="MM",X(10)="MU",X(11)="THOUU",X(12)="MG-PE",X(13)="NANOGRAM"
|
|---|
| 61 | I PN'["A",PN'["B" S PSJ=0 Q
|
|---|
| 62 | S PSJ=PSJ+1
|
|---|
| 63 | I PN["A" S PSJ(+PN,"A")=U_X(+$P($G(^PS(52.6,+PN,0)),U,3)) Q
|
|---|
| 64 | I PN["B" S PSJ(+PN,"B")=+$P($G(^PS(52.7,+PN,0)),U,3)_U_X(1) Q
|
|---|
| 65 | Q
|
|---|
| 66 | ;
|
|---|
| 67 | ENREF(PRX) ; Return number of refills remaining.
|
|---|
| 68 | ;Input: PRX - Internal prescription number from File #52.
|
|---|
| 69 | ;Output: Number of refills remaining.
|
|---|
| 70 | ;
|
|---|
| 71 | N X,COUNT,CNT S PRX=$P(PRX,"^"),COUNT=0,X=$P(^PSRX(PRX,0),"^",9)
|
|---|
| 72 | D:$O(^PSRX(PRX,1,0))
|
|---|
| 73 | .F CNT=0:0 S CNT=$O(^PSRX(PRX,1,CNT)) Q:'CNT S COUNT=COUNT+1
|
|---|
| 74 | S:$G(COUNT) X=X-COUNT
|
|---|
| 75 | Q X
|
|---|
| 76 | ;
|
|---|
| 77 | ENCHK(DFN,PSJINX) ; Return dispense drug check array.
|
|---|
| 78 | ;Input: DFN - Patient internal entry number
|
|---|
| 79 | ; PSJINX - Index number so duplicate drugs will be returned.
|
|---|
| 80 | ; PSGOCHK - Check should include dispense drugs in 53.45
|
|---|
| 81 | ; PSIVOCHK - Check should include entries in DRG array
|
|---|
| 82 | ;Output: ^TMP($J,"ORDERS",PSJINX)=DRUG CLASS^NATIONAL DRUG FILE ENTRY
|
|---|
| 83 | ; _"A"_PSNDFA PRODUCT NAME ENTRY_DISPENSE DRUG NAME^OE/RR #
|
|---|
| 84 | ; _ORDER NUMBER(P/I/V)_";I"
|
|---|
| 85 | ;
|
|---|
| 86 | NEW BDT,DDRUG,DDRUG0,DDRUGND,EDT,F,ON,ON1,PST,WBDT,X,PSJORIEN
|
|---|
| 87 | ;* S BDT=DT,WBDT=BDT_".000001",EDT=9999999
|
|---|
| 88 | D NOW^%DTC S (BDT,WBDT)=%,EDT=9999999
|
|---|
| 89 | S F="^PS(55,DFN,5," F S WBDT=$O(^PS(55,DFN,5,"AUS",WBDT)) Q:'WBDT F ON=0:0 S ON=$O(^PS(55,DFN,5,"AUS",WBDT,ON)) Q:'ON D UD
|
|---|
| 90 | S F="^PS(53.1," F PST="P","N" F ON=0:0 S ON=$O(^PS(53.1,"AS",PST,DFN,ON)) Q:'ON D
|
|---|
| 91 | . I $O(^PS(53.1,+ON,"AD",0))!$O(^PS(53.1,+ON,"SOL",0)) D PIV Q
|
|---|
| 92 | . D UD
|
|---|
| 93 | S WBDT=BDT F S WBDT=$O(^PS(55,DFN,"IV","AIS",WBDT)) Q:'WBDT F ON=0:0 S ON=$O(^PS(55,DFN,"IV","AIS",WBDT,ON)) Q:'ON D IV
|
|---|
| 94 | I '$G(PSIVOCON) D NEWIV ; Don't do this when Finishing orders (FN)
|
|---|
| 95 | Q
|
|---|
| 96 | UD ;*** Get the dispense drugs for the Unit Dose orders.
|
|---|
| 97 | S PSJORIEN=$P(@(F_ON_",0)"),U,21),DDRUG=0
|
|---|
| 98 | I F="^PS(53.1,",($P(@(F_ON_",0)"),U,4)="I") D Q
|
|---|
| 99 | . NEW PSJPD S COD=ON_"P"
|
|---|
| 100 | . S PSJPD=+$G(^PS(53.1,ON,.2)) D:$D(^PS(52.6,"AOI",PSJPD)) ENDDIV^PSJORUTL(PSJPD,"A","",.DDRUG) S DDRUG=+DDRUG D:DDRUG DDRUG
|
|---|
| 101 | S ON1=0 F S ON1=$O(@(F_ON_",1,"_ON1_")")) Q:'ON1 S DDRUG=@(F_ON_",1,"_ON1_",0)") I $P(DDRUG,U,3)=""!($P(DDRUG,U,3)>BDT) S COD=ON_$S(F["^PS(53.1":"P",1:"U") D DDRUG
|
|---|
| 102 | I $D(PSGOCHK) F ON1=0:0 S ON1=$O(^PS(53.45,+PSJSYSP,1,ON1)) Q:'ON1 S DDRUG=$G(^PS(53.45,+PSJSYSP,1,ON1,0)) I $P(DDRUG,U,3)=""!@($P(DDRUG,U,3)>BDT) S (COD,PSJORIEN)="" D DDRUG
|
|---|
| 103 | I '$O(@(F_ON_",1,"_0_")")) N OI S OI=+$G(@(F_ON_",.2)")) I OI D
|
|---|
| 104 | .S DDRUG="" F S DDRUG=$O(^PSDRUG("ASP",OI,DDRUG)) Q:'DDRUG D
|
|---|
| 105 | ..I ($P(DDRUG,U,3)=""!($P(DDRUG,U,3)>BDT)) S COD=ON_$S(F["^PS(53.1":"P",1:"U") D DDRUG
|
|---|
| 106 | Q
|
|---|
| 107 | PIV ;*** Get the dispense drugs for the Pending IV orders.
|
|---|
| 108 | S X=^PS(53.1,+ON,0),PSJORIEN=$P(X,U,21) Q:$P(X,U,27)="R"
|
|---|
| 109 | S ON1=0 F S ON1=$O(^PS(53.1,+ON,"AD",ON1)) Q:'ON1 S X=+^PS(53.1,+ON,"AD",ON1,0),DDRUG=$P($G(^PS(52.6,X,0)),U,2) S COD=+ON_"P" D DDRUG
|
|---|
| 110 | S ON1=0 F S ON1=$O(^PS(53.1,+ON,"SOL",ON1)) Q:'ON1 S X=+^PS(53.1,+ON,"SOL",ON1,0),DDRUG=$P($G(^PS(52.7,X,0)),U,2) S COD=+ON_"P" D DDRUG
|
|---|
| 111 | Q
|
|---|
| 112 | IV ;*** Get the dispense drugs for the IV orders.
|
|---|
| 113 | NEW X S X=^PS(55,DFN,"IV",ON,0),PSJORIEN=$P(X,U,21) Q:$P(X,U,17)="R"
|
|---|
| 114 | S ON1=0 F S ON1=$O(^PS(55,DFN,"IV",ON,"AD",ON1)) Q:'ON1 S X=+^PS(55,DFN,"IV",ON,"AD",ON1,0),DDRUG=$P($G(^PS(52.6,X,0)),U,2) S COD=ON_"V" D DDRUG
|
|---|
| 115 | S ON1=0 F S ON1=$O(^PS(55,DFN,"IV",ON,"SOL",ON1)) Q:'ON1 S X=+^PS(55,DFN,"IV",ON,"SOL",ON1,0),DDRUG=$P($G(^PS(52.7,X,0)),U,2) S COD=ON_"V" D DDRUG
|
|---|
| 116 | ;*D:$G(PSIVNEW) NEWIV
|
|---|
| 117 | Q
|
|---|
| 118 | NEWIV ;*** Get the dispense drugs for the newly entered IV order.
|
|---|
| 119 | NEW PSIVX,ON
|
|---|
| 120 | S ON=$O(DRGOC(0)),PSJORIEN="" Q:'+ON
|
|---|
| 121 | F PSIVX=0:0 S PSIVX=$O(DRGOC(ON,"AD",PSIVX)) Q:'PSIVX S DDRUG=$P(^PS(52.6,+DRGOC(ON,"AD",PSIVX),0),U,2),COD=ON55 D DDRUG
|
|---|
| 122 | F PSIVX=0:0 S PSIVX=$O(DRGOC(ON,"SOL",PSIVX)) Q:'PSIVX S DDRUG=$P(^PS(52.7,+DRGOC(ON,"SOL",PSIVX),0),U,2),COD=ON D DDRUG
|
|---|
| 123 | Q
|
|---|
| 124 | DDRUG ;*** Set PSJ(DDRUG NAME) arrays.
|
|---|
| 125 | Q:'DDRUG S DDRUG0=$G(^PSDRUG(+DDRUG,0)),DDRUGND=$G(^PSDRUG(+DDRUG,"ND"))
|
|---|
| 126 | S PSJINX=+$G(PSJINX)+1 ;* ^PSOORDRG calls this entry point.
|
|---|
| 127 | I $D(DDRUG)=11,DDRUG[";" D Q ; if called from ^PSOORDRG
|
|---|
| 128 | .N IPOROP S IPOROP=$P(DDRUG,";",2)
|
|---|
| 129 | .S IPOROP=$S(IPOROP="PSO":";O",IPOROP="PSH":"N;O",1:";I")
|
|---|
| 130 | .S ^TMP($J,"ORDERS",PSJINX)=$P(DDRUG0,U,2)_U_$P(DDRUGND,U)_"A"_$P(DDRUGND,U,3)_U_$P(DDRUG0,U)_U_$S($G(DDRUG(DDRUG)):DDRUG(DDRUG),1:$G(PSJORIEN))_U_$G(COD)_IPOROP
|
|---|
| 131 | S ^TMP($J,"ORDERS",PSJINX)=$P(DDRUG0,U,2)_U_$P(DDRUGND,U)_"A"_$P(DDRUGND,U,3)_U_$P(DDRUG0,U)_U_$G(PSJORIEN)_U_$G(COD)_";I"
|
|---|
| 132 | Q
|
|---|
| 133 | ;
|
|---|
| 134 | PRCHK(PSJ) ; Check if authorized to write med orders.
|
|---|
| 135 | N %,X
|
|---|
| 136 | D NOW^%DTC S X=$G(^VA(200,PSJ,"PS")) I $S('X:1,'$P(%,"^",4):0,1:$P(X,"^",4)'>%) Q 0
|
|---|
| 137 | Q PSJ
|
|---|
| 138 | ;
|
|---|
| 139 | ENNG(PSJDPT,PSJNUM) ; returns 1 if order marked "Not To Be Given"
|
|---|
| 140 | ; 0 if not marked
|
|---|
| 141 | I '$D(^PS(55,PSJDPT,5,+PSJNUM,0)) Q 0
|
|---|
| 142 | I $P($G(^PS(55,PSJDPT,5,+PSJNUM,0)),"^",22)=1 Q 1
|
|---|
| 143 | Q 0
|
|---|
