source: FOIAVistA/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJORUTL.m@ 677

Last change on this file since 677 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.1 KB
Line 
1PSJORUTL ;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 ;
12ENDD(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 ;
31ENDDIV(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 ;
48ENDCM(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 ;
57ENRFA(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 ;
73ENDF(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 ;
83ENNDFS(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 ;
90ENDI(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 ;
106ENSDC(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 ;
110MAX ;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
Note: See TracBrowser for help on using the repository browser.