Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSJORUTL

PSJORUTL.m

Go to the documentation of this file.
  1. PSJORUTL ;BIR/MLM-MISC. PROCEDURE CALLS FOR OE/RR 3.0 ;24 Feb 99 / 10:43 AM
  1. ;;5.0;INPATIENT MEDICATIONS ;**4,14,22,256,358**;16 DEC 97;Build 10
  1. ;
  1. ;Reference to ^PS(50.416 is supported by DBIA 2196
  1. ;Reference to ^PS(50.606 is supported by DBIA 2174
  1. ;Reference to ^PS(52.6 is supported by DBIA 1231
  1. ;Reference to ^PS(52.7 is supported by DBIA 2173
  1. ;Reference to ^PSDRUG is supported by DBIA 2192
  1. ;Reference to ^PSNDF( is supported by DBIA 2195
  1. ;Reference to ^YSCL(603.01 is supported by DBIA 2697
  1. ;
  1. ENDD(PD,TYP,PSJ,DFN) ; Find all entries in DRUG file (50) for the passed primary/usage.
  1. ;Input: PD - NATIONAL DRUG FILE ENTRY (20).PSNDF VA PRODUCT NAME ENTRY
  1. ; ^NDF ptr.NDF form ptr^NDF Name^Primary IEN^Primary
  1. ; Name^"99PSP".
  1. ; TYP- String identifying type of drug (O:OP; U:UD; I:IV etc).
  1. ;Output:PSJ- Array containing all entries in the DRUG file (50) tied
  1. ; to the PD for the type(s) of drugs specified. Array is
  1. ; returned: ARRAY(PSJ)=IEN^GENERIC NAME (.01)^PRICE PER
  1. ; DISPENSE UNIT (16)^NON-FORMULARY (51)^DISPENSE UNIT (14.5)
  1. ; ^MAX NUMBER OF REFILLS ;5.27.97/SAB
  1. ; If no 50 entries found, PSJ=0; Else PSJ=# of entries.
  1. ;
  1. N MAX,DEA,DEAI,DDRG,INACT,ND,X,Y S PSJ=0,PD=+$P(PD,U,4)
  1. 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
  1. .F X=1:1:$L(TYP) I Y[$E(TYP,X) S Y=1 Q
  1. .D:Y
  1. ..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
  1. Q
  1. ;
  1. ENDDIV(PD,TYP,VOLUME,PSJ) ; Find all entries in DRUG file (50) for the passed Orderable item, IV additive/solution.
  1. ;Input: PD - Orderable item Pointer.
  1. ; TYP- String identifying type of drug (A:ADDITIVE, B:BASE).
  1. ; VOLUME- Volume used to uniquely identify a dispense drug.
  1. ;Output:PSJ- A string containing all entries in the DRUG file (50) tied
  1. ; to the PD for the type(s) of drugs specified. This string
  1. ; returned: PSJ=IEN^GENERIC NAME (.01)^PRICE PER DISPENSE
  1. ; UNIT (16)^NON-FORMULARY (51)^DISPENSE UNIT (14.5)
  1. ;
  1. NEW PSJIENS,Y S PSJ=0
  1. Q:$G(PD)=""
  1. Q:$G(TYP)=""
  1. S:TYP="A" PSJIENS=$$ADDD^PSJMISC(PD)
  1. S:TYP="B" PSJIENS=$$SOLDD^PSJMISC(PD,$G(VOLUME))
  1. I PSJIENS="" Q
  1. S ND=$G(^PSDRUG(+PSJIENS,0)),Y=$G(^(660)),PSJ=+PSJIENS_U_$P(ND,U)_U_$P(Y,U,6)_U_$P(ND,U,9)_U_$P(Y,U,8)
  1. Q
  1. ;
  1. ENDCM(DDRG) ; Find Drug Cost, Message, and VA Product Name IEN
  1. ;Input: DDRG - IEN of entry in DRUG file (50).
  1. ;Output: PRICE PER DISPENSE UNIT(16)^MESSAGE (101)^NATIONAL DRUG FILE
  1. ; ENTRY(20).PSNDF VA PRODUCT NAME ENTRY (22)^QTY DISPENSE MESSAGE
  1. ; If either NDF ptr is not found 0 will be returned instead of 20.22.
  1. ;
  1. N X S X=$G(^PSDRUG(+DDRG,"ND"))
  1. 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)),"^")
  1. ;
  1. ENRFA(DDRG,TYP,PSJ) ; Returns formulary alternatives for a dispense drug.
  1. ;Input: DDRG - IEN of entry in DRUG file (50).
  1. ; TYP - String identifying type of drug (O:OP; U:UD; I:IV etc).
  1. ;Output: ARRAY(INDEX#)=IEN of Formulary alternative^Formulary
  1. ; alternative name^Formulary alternative cost^Orderable Item
  1. ; IEN^Orderable Item name^MAX NUMBER REFILLS.
  1. ;If no alternatives are found PSJ=0; Else PSJ=# of entries.
  1. ;
  1. K PSJ S PSJ=0 Q:'$O(^PSDRUG(+DDRG,65,0))
  1. N MAX,DEA,DEAI,X,XX,Y,YY S YY=0
  1. F X=0:0 S X=$O(^PSDRUG(+DDRG,65,X)) Q:'X S Y=$G(^PSDRUG(+DDRG,65,X,0)) I X D
  1. .F XX=1:1:$L(TYP) I $P($G(^PSDRUG(+Y,2)),U,3)[$E(TYP,XX) S YY=1 Q
  1. .D:YY
  1. ..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
  1. Q
  1. ;
  1. ENDF(PN) ; Returns dosage form for the specified VA Product Name.
  1. ;Input: PN - NATIONAL DRUG FILE ENTRY (20).PSNDF VA PRODUCT NAME ENTRY
  1. ;Output: NDF Dosage Form IEN^NDF Dosage From IEN
  1. ;
  1. ; NEW NDF CALL
  1. 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)
  1. ;
  1. 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)
  1. Q $S(PSJDF="":0,'X:0,1:+X_U_PSJDF)
  1. ;
  1. ENNDFS(PN) ; Returns STRENGTH from ^PSNDF for the specified VA Product Name.
  1. ; NEW NDF CALL
  1. 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)
  1. ;
  1. 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)
  1. Q $S(PNS="":0,'X:0,1:+X_U_PNS)
  1. ;
  1. ENDI(PN,PSJ) ; Find all ingredients for the passed dispense drug.
  1. ;Input: PN - VA Product Name IEN
  1. ;Output: PSJ - Array listing ingredients for the specified PN in the
  1. ; form of PSJ(Ing. file ptr (50.416))=Ing IEN^Ing. name
  1. ; ^Ing. amt./Ing. units
  1. ;If no ing. found, PSJ=0. If ing. found, PSJ=1
  1. ; NEW NDF CALL
  1. 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
  1. ;
  1. N GDP,ING,INGND,INGNME,INGPTR,PNP,X,Y
  1. S PSJ=0,GDP=$P(PN,"."),PNP=$P(PN,".",2)
  1. F X=1:1:3 S INGND=$G(^PSNDF(+GDP,5,+PNP,X)) F Y=1:1:$L(INGND,",") D
  1. .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)))
  1. .S PSJ=1,PSJ(+INGPTR)=INGPTR_U_INGNME_U_$P(ING,"/",2,3)
  1. Q
  1. ;
  1. ENSDC(PSGP) ; Add IV and UD orders to ^TMP global used for order checking.
  1. ; Input: PSGP - Patient IEN
  1. ; Output: ^TMP($J("ORDERS",DRUG NAME)=DRUG CLASS CODE^NDF POINTER*
  1. ;
  1. MAX ;returns max number of refills for outpatient orders ;5.27.97/SAB
  1. K MAX S DEA=$P($G(^PSDRUG(DDRG,0)),"^",3)
  1. I $P($G(^PSDRUG(DDRG,"CLOZ1")),"^")="PSOCLO1",$G(DFN) D Q
  1. .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
  1. I DEA["A",DEA'["B" S MAX=0 K DEA Q
  1. F DEAI=1:1:$L(DEA) I $E(+DEA,DEAI)>1,$E(+DEA,DEAI)<6 S MAX=5
  1. K DEA,DEAI Q:$G(MAX)=5 S MAX=11
  1. Q