| 1 | PSJORUTL ;BIR/MLM-MISC. PROCEDURE CALLS FOR OE/RR 3.0 ;24 Feb 99 / 10:43 AM
|
---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;**4,14,22**;16 DEC 97
|
---|
| 3 | ;
|
---|
| 4 | ;Reference to ^PS(50.416 is supported by DBIA 2196
|
---|
| 5 | ;Reference to ^PS(50.606 is supported by DBIA 2174
|
---|
| 6 | ;Reference to ^PS(52.6 is supported by DBIA 1231
|
---|
| 7 | ;Reference to ^PS(52.7 is 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 ^YSCL(603.01 is supported by DBIA 2697
|
---|
| 11 | ;
|
---|
| 12 | ENDD(PD,TYP,PSJ,DFN) ; Find all entries in DRUG file (50) for the passed primary/usage.
|
---|
| 13 | ;Input: PD - NATIONAL DRUG FILE ENTRY (20).PSNDF VA PRODUCT NAME ENTRY
|
---|
| 14 | ; ^NDF ptr.NDF form ptr^NDF Name^Primary IEN^Primary
|
---|
| 15 | ; Name^"99PSP".
|
---|
| 16 | ; TYP- String identifying type of drug (O:OP; U:UD; I:IV etc).
|
---|
| 17 | ;Output:PSJ- Array containing all entries in the DRUG file (50) tied
|
---|
| 18 | ; to the PD for the type(s) of drugs specified. Array is
|
---|
| 19 | ; returned: ARRAY(PSJ)=IEN^GENERIC NAME (.01)^PRICE PER
|
---|
| 20 | ; DISPENSE UNIT (16)^NON-FORMULARY (51)^DISPENSE UNIT (14.5)
|
---|
| 21 | ; ^MAX NUMBER OF REFILLS ;5.27.97/SAB
|
---|
| 22 | ; If no 50 entries found, PSJ=0; Else PSJ=# of entries.
|
---|
| 23 | ;
|
---|
| 24 | N MAX,DEA,DEAI,DDRG,INACT,ND,X,Y S PSJ=0,PD=+$P(PD,U,4)
|
---|
| 25 | F DDRG=0:0 S DDRG=$O(^PSDRUG("ASP",PD,DDRG)) Q:'DDRG S INACT=$G(^PSDRUG(DDRG,"I")) I ('INACT)!(INACT'<DT) S Y=$P($G(^PSDRUG(DDRG,2)),U,3) D
|
---|
| 26 | .F X=1:1:$L(TYP) I Y[$E(TYP,X) S Y=1 Q
|
---|
| 27 | .D:Y
|
---|
| 28 | ..S ND=$G(^PSDRUG(DDRG,0)),Y=$G(^(660)),PSJ=PSJ+1,PSJ(PSJ)=DDRG_U_$P(ND,U)_U_$P(Y,U,6)_U_$P(ND,U,9)_U_$P(Y,U,8) D MAX S PSJ(PSJ)=PSJ(PSJ)_U_MAX K MAX
|
---|
| 29 | Q
|
---|
| 30 | ;
|
---|
| 31 | ENDDIV(PD,TYP,VOLUME,PSJ) ; Find all entries in DRUG file (50) for the passed Orderable item, IV additive/solution.
|
---|
| 32 | ;Input: PD - Orderable item Pointer.
|
---|
| 33 | ; TYP- String identifying type of drug (A:ADDITIVE, B:BASE).
|
---|
| 34 | ; VOLUME- Volume used to uniquely identify a dispense drug.
|
---|
| 35 | ;Output:PSJ- A string containing all entries in the DRUG file (50) tied
|
---|
| 36 | ; to the PD for the type(s) of drugs specified. This string
|
---|
| 37 | ; returned: PSJ=IEN^GENERIC NAME (.01)^PRICE PER DISPENSE
|
---|
| 38 | ; UNIT (16)^NON-FORMULARY (51)^DISPENSE UNIT (14.5)
|
---|
| 39 | ;
|
---|
| 40 | N DDRG,FIL,ND,X,Y S PSJ=0
|
---|
| 41 | S FIL=$S(TYP="A":"52.6",1:52.7) S:'$D(VOLUME) VOLUME=""
|
---|
| 42 | F IVIEN=0:0 S IVIEN=$O(^PS(FIL,"AOI",PD,IVIEN)) Q:'IVIEN D
|
---|
| 43 | . S Y=$G(^PS(FIL,IVIEN,0)) Q:Y="" I TYP="B",(+VOLUME'=+$P(Y,U,3)) Q
|
---|
| 44 | . S DDRG=$P(Y,U,2)
|
---|
| 45 | . S ND=$G(^PSDRUG(DDRG,0)),Y=$G(^(660)),PSJ=DDRG_U_$P(ND,U)_U_$P(Y,U,6)_U_$P(ND,U,9)_U_$P(Y,U,8)
|
---|
| 46 | Q
|
---|
| 47 | ;
|
---|
| 48 | ENDCM(DDRG) ; Find Drug Cost, Message, and VA Product Name IEN
|
---|
| 49 | ;Input: DDRG - IEN of entry in DRUG file (50).
|
---|
| 50 | ;Output: PRICE PER DISPENSE UNIT(16)^MESSAGE (101)^NATIONAL DRUG FILE
|
---|
| 51 | ; ENTRY(20).PSNDF VA PRODUCT NAME ENTRY (22)^QTY DISPENSE MESSAGE
|
---|
| 52 | ; If either NDF ptr is not found 0 will be returned instead of 20.22.
|
---|
| 53 | ;
|
---|
| 54 | N X S X=$G(^PSDRUG(+DDRG,"ND"))
|
---|
| 55 | Q $P($G(^PSDRUG(+DDRG,660)),U,3)_U_$P($G(^(0)),U,10)_U_$S('+X:0,'$P(X,U,3):0,1:+X_"."_$P(X,U,3))_U_$P($G(^PSDRUG(+DDRG,5)),"^")
|
---|
| 56 | ;
|
---|
| 57 | ENRFA(DDRG,TYP,PSJ) ; Returns formulary alternatives for a dispense drug.
|
---|
| 58 | ;Input: DDRG - IEN of entry in DRUG file (50).
|
---|
| 59 | ; TYP - String identifying type of drug (O:OP; U:UD; I:IV etc).
|
---|
| 60 | ;Output: ARRAY(INDEX#)=IEN of Formulary alternative^Formulary
|
---|
| 61 | ; alternative name^Formulary alternative cost^Orderable Item
|
---|
| 62 | ; IEN^Orderable Item name^MAX NUMBER REFILLS.
|
---|
| 63 | ;If no alternatives are found PSJ=0; Else PSJ=# of entries.
|
---|
| 64 | ;
|
---|
| 65 | K PSJ S PSJ=0 Q:'$O(^PSDRUG(+DDRG,65,0))
|
---|
| 66 | N MAX,DEA,DEAI,X,XX,Y,YY S YY=0
|
---|
| 67 | F X=0:0 S X=$O(^PSDRUG(+DDRG,65,X)) Q:'X S Y=$G(^PSDRUG(+DDRG,65,X,0)) I X D
|
---|
| 68 | .F XX=1:1:$L(TYP) I $P($G(^PSDRUG(+Y,2)),U,3)[$E(TYP,XX) S YY=1 Q
|
---|
| 69 | .D:YY
|
---|
| 70 | ..S YY=+$G(^PSDRUG(+Y,2)),PSJ=PSJ+1,PSJ(+Y)=+Y_U_$$ENDDN^PSGMI(+Y)_U_$P($G(^PSDRUG(+Y,660)),U,6)_U_YY_U_$$OIDF^PSJLMUT1(YY) D MAX S PSJ(+Y)=PSJ(+Y)_U_MAX K MAX
|
---|
| 71 | Q
|
---|
| 72 | ;
|
---|
| 73 | ENDF(PN) ; Returns dosage form for the specified VA Product Name.
|
---|
| 74 | ;Input: PN - NATIONAL DRUG FILE ENTRY (20).PSNDF VA PRODUCT NAME ENTRY
|
---|
| 75 | ;Output: NDF Dosage Form IEN^NDF Dosage From IEN
|
---|
| 76 | ;
|
---|
| 77 | ; NEW NDF CALL
|
---|
| 78 | N X S X="PSNAPIS" X ^%ZOSF("TEST") I N PSJDF,X1,X2 S X1=+$P(PN,"."),X2=+$P(PN,".",2),PSJDF=$$PSJDF^PSNAPIS(X1,X2) Q $S(PSJDF="":0,1:PSJDF)
|
---|
| 79 | ;
|
---|
| 80 | N PSJNDF,X S X=$P($G(^PSNDF(+$P(PN,"."),5,+$P(PN,".",2),0)),U,2),X=+$G(^PSNDF(+$P(PN,"."),2,+X,0)),PSJDF=$P($G(^PS(50.606,+X,0)),U)
|
---|
| 81 | Q $S(PSJDF="":0,'X:0,1:+X_U_PSJDF)
|
---|
| 82 | ;
|
---|
| 83 | ENNDFS(PN) ; Returns STRENGTH from ^PSNDF for the specified VA Product Name.
|
---|
| 84 | ; NEW NDF CALL
|
---|
| 85 | N X S X="PSNAPIS" X ^%ZOSF("TEST") I N X1,X2,PNS S X1=+$P(PN,"."),X2=+$P(PN,".",2),PNS=$$PSJST^PSNAPIS(X1,X2) Q $S(PNS="":0,1:PNS)
|
---|
| 86 | ;
|
---|
| 87 | N PNS,X,Y S X=$P($G(^PSNDF(+$P(PN,"."),5,+$P(PN,".",2),0)),U,3),Y=+$P($G(^PSNDF(+$P(PN,"."),5,+$P(PN,".",2),0)),"^",2),PNS=$P($G(^PSNDF(+$P(PN,"."),2,+Y,3,+X,0)),U)
|
---|
| 88 | Q $S(PNS="":0,'X:0,1:+X_U_PNS)
|
---|
| 89 | ;
|
---|
| 90 | ENDI(PN,PSJ) ; Find all ingredients for the passed dispense drug.
|
---|
| 91 | ;Input: PN - VA Product Name IEN
|
---|
| 92 | ;Output: PSJ - Array listing ingredients for the specified PN in the
|
---|
| 93 | ; form of PSJ(Ing. file ptr (50.416))=Ing IEN^Ing. name
|
---|
| 94 | ; ^Ing. amt./Ing. units
|
---|
| 95 | ;If no ing. found, PSJ=0. If ing. found, PSJ=1
|
---|
| 96 | ; NEW NDF CALL
|
---|
| 97 | N X S X="PSNAPIS" X ^%ZOSF("TEST") I N X1,X2 S X1=+$P(PN,"."),X2=+$P(PN,".",2),PSJ=$$PSJING^PSNAPIS(X1,X2,.PSJ) Q
|
---|
| 98 | ;
|
---|
| 99 | N GDP,ING,INGND,INGNME,INGPTR,PNP,X,Y
|
---|
| 100 | S PSJ=0,GDP=$P(PN,"."),PNP=$P(PN,".",2)
|
---|
| 101 | F X=1:1:3 S INGND=$G(^PSNDF(+GDP,5,+PNP,X)) F Y=1:1:$L(INGND,",") D
|
---|
| 102 | .S ING=$P(INGND,",",Y),INGNME=$P($G(^PSNDF(+GDP,1,+ING,0)),U),INGPTR=$S(INGNME="":"Not Found",1:$O(^PS(50.416,"B",INGNME,0)))
|
---|
| 103 | .S PSJ=1,PSJ(+INGPTR)=INGPTR_U_INGNME_U_$P(ING,"/",2,3)
|
---|
| 104 | Q
|
---|
| 105 | ;
|
---|
| 106 | ENSDC(PSGP) ; Add IV and UD orders to ^TMP global used for order checking.
|
---|
| 107 | ; Input: PSGP - Patient IEN
|
---|
| 108 | ; Output: ^TMP($J("ORDERS",DRUG NAME)=DRUG CLASS CODE^NDF POINTER*
|
---|
| 109 | ;
|
---|
| 110 | MAX ;returns max number of refills for outpatient orders ;5.27.97/SAB
|
---|
| 111 | K MAX S DEA=$P($G(^PSDRUG(DDRG,0)),"^",3)
|
---|
| 112 | I $P($G(^PSDRUG(DDRG,"CLOZ1")),"^")="PSOCLO1",$G(DFN) D Q
|
---|
| 113 | .S CLOZPAT=$O(^YSCL(603.01,"C",DFN,0)) S MAX=$S($P($G(^YSCL(603.01,+CLOZPAT,0)),"^",3)="B":1,1:0) K CLOZPAT
|
---|
| 114 | I DEA["A",DEA'["B" S MAX=0 K DEA Q
|
---|
| 115 | F DEAI=1:1:$L(DEA) I $E(+DEA,DEAI)>1,$E(+DEA,DEAI)<6 S MAX=5
|
---|
| 116 | K DEA,DEAI Q:$G(MAX)=5 S MAX=11
|
---|
| 117 | Q
|
---|