source: WorldVistAEHR/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSSUTIL1.m@ 1006

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

initial load of WorldVistAEHR

File size: 5.8 KB
Line 
1PSSUTIL1 ;BIR/RTR-Utility routine ;08/21/00
2 ;;1.0;PHARMACY DATA MANAGEMENT;**38,66,69**;9/30/97
3 ;Reference to ^PS(50.607 supported by DBIA #2221
4 ;Reference to ^PSNAPIS supported by DBIA 2531
5 ;
6EN(PSSDRIEN) ;
7 N PSSMASH,PSSMNDFS,PSSMSSTR,PSSMUNIT,PSSUNZ,PSSMA,PSSMB,PSSMA1,PSSMB1,PSSUNX,PSSMASH2,PSSMASH3,PSSNAT1,PSSNAT3,PSSNODEU
8 I '$G(PSSDRIEN) Q "|^^^^^99PSU"
9 S PSSMSSTR=$P($G(^PSDRUG(PSSDRIEN,"DOS")),"^"),PSSMUNIT=$P($G(^("DOS")),"^",2)
10 S PSSNAT1=$P($G(^PSDRUG(PSSDRIEN,"ND")),"^"),PSSNAT3=$P($G(^("ND")),"^",3) I PSSNAT1,PSSNAT3 S PSSNODEU=$$DFSU^PSNAPIS(PSSNAT1,PSSNAT3) S PSSMNDFS=$P(PSSNODEU,"^",4) S:'$G(PSSMUNIT) PSSMUNIT=$P(PSSNODEU,"^",5)
11 S PSSUNZ=$P($G(^PS(50.607,+$G(PSSMUNIT),0)),"^")
12 I PSSUNZ'["/" Q $S($G(PSSMSSTR)'="":$G(PSSMSSTR),$G(PSSMNDFS)'="":$G(PSSMNDFS),1:"")_"|"_"^^^"_$S($G(PSSMUNIT):$G(PSSMUNIT),1:"")_"^"_$G(PSSUNZ)_"^"_"99PSU"
13 S PSSMASH=0
14 I $G(PSSMSSTR),$G(PSSMNDFS),+$G(PSSMSSTR)'=+$G(PSSMNDFS) S PSSMASH=1
15 I 'PSSMASH Q PSSMSSTR_"|"_"^^^"_$S($G(PSSMUNIT):$G(PSSMUNIT),1:"")_"^"_$G(PSSUNZ)_"^"_"99PSU"
16 S PSSMA=$P(PSSUNZ,"/"),PSSMB=$P(PSSUNZ,"/",2),PSSMA1=+$G(PSSMA),PSSMB1=+$G(PSSMB)
17 S PSSMASH2=PSSMSSTR/PSSMNDFS,PSSMASH3=PSSMASH2*($S($G(PSSMB1):$G(PSSMB1),1:1))
18 S PSSUNX=$G(PSSMA)_"/"_$G(PSSMASH3)_$S('$G(PSSMB1):$G(PSSMB),1:$P(PSSMB,PSSMB1,2))
19 Q $S($G(PSSMSSTR)'="":$G(PSSMSSTR),$G(PSSMNDFS)'="":$G(PSSMNDFS),1:"")_"|"_"^^^^"_$G(PSSUNX)_"^"_"99PSU"
20 ;
21 Q
22 ;
23DRG(PSSDD,PSSOI,PSSPK) ;
24 ; PSSDD - Array of Drugs
25 ; PSSOI - Orderable Item (Pharmacy)
26 ; PSSPK - Application Package ("O"-Outpatient;"I"-IV;"X"-Non-VA Med)
27 ;Return active dispense drugs for package based on Orderable Item
28 N PSSL,PSSAP,PSSIN,PSSND
29 Q:'$G(PSSOI)
30 I $G(PSSPK)'="O",$G(PSSPK)'="I",$G(PSSPK)'="X" Q
31 F PSSL=0:0 S PSSL=$O(^PSDRUG("ASP",PSSOI,PSSL)) Q:'PSSL D
32 . S PSSIN=$P($G(^PSDRUG(PSSL,"I")),"^"),PSSAP=$P($G(^(2)),"^",3)
33 . I PSSIN,PSSIN<DT Q
34 . S PSSND=$P($G(^PSDRUG(PSSL,"ND")),"^")
35 . I PSSPK="O"!(PSSPK="X") D Q
36 . . S:PSSAP[PSSPK PSSDD(PSSL_";"_PSSND)=$P($G(^PSDRUG(PSSL,0)),"^")
37 . I PSSAP["I"!(PSSAP["U") D
38 . . S PSSDD(PSSL_";"_PSSND)=$P($G(^PSDRUG(PSSL,0)),"^")
39 Q
40 ;
41ITEM(PSSIT,PSSDR) ;Return Orderable Item to CPRS
42 N PSSNEW
43 I '$G(PSSIT)!('$G(PSSDR)) Q -1
44 I '$D(^PS(50.7,+$G(PSSIT),0))!('$D(^PSDRUG(+$G(PSSDR),0))) Q -1
45 S PSSNEW=+$P($G(^PSDRUG(+$G(PSSDR),2)),"^")
46 I PSSNEW,PSSNEW=$G(PSSIT) Q 0
47 I PSSNEW,PSSNEW'=$G(PSSIT) Q 1_"^"_PSSNEW
48 Q -1
49 ;
50 Q
51 ;
52EN1(PSSOA,PSSOAP) ;
53 ;Return Orderable Item Forumary Alternatives to CPRS
54 ;PSSOA = Pharmacy Orderable Item number
55 ;PSSOAP = "I" For Inpatient, "O" For Outpatient
56 Q:'$G(PSSOA)
57 I $G(PSSOAP)'="O",$G(PSSOAP)'="I" Q
58 N PSSOAL,PSSOALD,PSSOAN,PSSOAIT,PSSOADT,PSSOAZ
59 S PSSOAL="" F S PSSOAL=$O(^PSDRUG("ASP",PSSOA,PSSOAL)) Q:PSSOAL="" D
60 .S PSSOALD="" F S PSSOALD=$O(^PSDRUG(PSSOAL,65,PSSOALD)) Q:PSSOALD="" D
61 ..S PSSOAN=$P($G(^PSDRUG(PSSOAL,65,PSSOALD,0)),"^") I PSSOAN S PSSOAIT=$P($G(^PSDRUG(PSSOAN,2)),"^") D:PSSOAIT
62 ...Q:PSSOAIT=PSSOA
63 ...Q:$D(PSSOA(PSSOAIT))
64 ...Q:'$D(^PS(50.7,PSSOAIT,0))!($P($G(^PS(50.7,PSSOAIT,0)),"^",12))
65 ...Q:$P($G(^PS(50.7,PSSOAIT,0)),"^",4)&(+$P($G(^(0)),"^",4)'>DT)
66 ...S PSSOAZ="" F S PSSOAZ=$O(^PSDRUG("ASP",PSSOAIT,PSSOAZ)) Q:PSSOAZ=""!($D(PSSOA(PSSOAIT))) D
67 ....Q:$P($G(^PSDRUG(PSSOAZ,"I")),"^")&(+$P($G(^("I")),"^")'>DT)
68 ....Q:$P($G(^PSDRUG(PSSOAZ,0)),"^",9)
69 ....I $G(PSSOAP)="O" S:$P($G(^PSDRUG(PSSOAZ,2)),"^",3)["O" PSSOA(PSSOAIT)="" Q
70 ....I $P($G(^PSDRUG(PSSOAZ,2)),"^",3)["I"!($P($G(^(2)),"^",3)["U") S PSSOA(PSSOAIT)=""
71 Q
72SCH(SCH) ;Expand schedule for Outpatient order in CPRS
73 N SQFLAG,SCLOOP,SCLP,SCLPS,SCLHOLD,SCIN,SODL,SST,SCHEX
74 S SCHEX=$G(SCH) S SQFLAG=0
75 I $G(SCH)="" G SCHQT
76 ;I SCH[""""!($A(SCH)=45)!(SCH?.E1C.E)!($L(SCH," ")>3)!($L(SCH)>20)!($L(SCH)<1) K SCH Q
77 F SCLOOP=0:0 S SCLOOP=$O(^PS(51.1,"B",SCH,SCLOOP)) Q:'SCLOOP!(SQFLAG) I $P($G(^PS(51.1,SCLOOP,0)),"^",8)'="" S SCHEX=$P($G(^(0)),"^",8),SQFLAG=1
78 I SQFLAG G SCHQT
79 I $P($G(^PS(51,"A",SCH)),"^")'="" S SCHEX=$P(^(SCH),"^") G SCHQT
80 S SCLOOP=0 F SCLP=1:1:$L(SCH) S SCLPS=$E(SCH,SCLP) I SCLPS=" " S SCLOOP=SCLOOP+1
81 I SCLOOP=0 S SCHEX=SCH G SCHQT
82 S SCLOOP=SCLOOP+1
83 K SCLHOLD F SCIN=1:1:SCLOOP S (SODL,SCLHOLD(SCIN))=$P(SCH," ",SCIN) D
84 .Q:$G(SODL)=""
85 .S SQFLAG=0 F SST=0:0 S SST=$O(^PS(51.1,"B",SODL,SST)) Q:'SST!($G(SQFLAG)) I $P($G(^PS(51.1,SST,0)),"^",8)'="" S SCLHOLD(SCIN)=$P($G(^(0)),"^",8),SQFLAG=1
86 .Q:$G(SQFLAG)
87 .I $P($G(^PS(51,"A",SODL)),"^")'="" S SCLHOLD(SCIN)=$P(^(SODL),"^")
88 S SCHEX="",SQFLAG=0 F SST=1:1:SCLOOP S SCHEX=SCHEX_$S($G(SQFLAG):" ",1:"")_$G(SCLHOLD(SST)),SQFLAG=1
89SCHQT ;
90 S SCH=SCHEX
91 Q
92 ;
93IVDEA(PSSIVOI,PSSIVOIP) ;DEA Special Handling to CPRS for IV Fluids dialogue
94 ;parameter 1 is Orderable Item
95 ;parameter 2 is "A" for Additive, "S" for Solution
96 ;Return variables: 1 - DEA contains a 1 or a 2
97 ;2 - DEA contains a 3, 4, or 5
98 ;0 - first 2 conditions not met, but active additive/solutions exist
99 ;null - no active additive/solution for the Orderable Item
100 N PSSIVDO,PSSIVDD,PSSIVL,PSSIVLP,PSSIVDEA,PSSIVLPX
101 S (PSSIVDO,PSSIVDD)=0
102 I $G(PSSIVOIP)'="S" S PSSIVOIP="A"
103 I '$G(PSSIVOI) G IVQ
104 S PSSIVL="" F S PSSIVL=$O(^PSDRUG("ASP",PSSIVOI,PSSIVL)) Q:PSSIVL=""!(PSSIVDO=1) D
105 .I $P($G(^PSDRUG(PSSIVL,"I")),"^"),$P($G(^("I")),"^")<DT Q
106 .I $P($G(^PSDRUG(PSSIVL,2)),"^",3)'["I",$P($G(^(2)),"^",3)'["U" Q
107 .I PSSIVOIP="A" D Q
108 ..S PSSIVLP="",PSSIVLPX=0 F S PSSIVLP=$O(^PSDRUG("A526",PSSIVL,PSSIVLP)) Q:PSSIVLP=""!(PSSIVDO=1)!(PSSIVLPX) D
109 ...I $D(^PS(52.6,PSSIVLP,0)) I '$P($G(^("I")),"^")!($P($G(^("I")),"^")>DT) S (PSSIVDD,PSSIVLPX)=1 D IVX
110 .S PSSIVLP="",PSSIVLPX=0 F S PSSIVLP=$O(^PSDRUG("A527",PSSIVL,PSSIVLP)) Q:PSSIVLP=""!(PSSIVDO=1)!(PSSIVLPX) D
111 ..I $D(^PS(52.7,PSSIVLP,0)) I '$P($G(^("I")),"^")!($P($G(^("I")),"^")>DT) S (PSSIVDD,PSSIVLPX)=1 D IVX
112IVQ ;
113 I PSSIVDO=0,'PSSIVDD S PSSIVDO=""
114 Q PSSIVDO
115 ;
116IVX ;
117 S PSSIVDEA=$P($G(^PSDRUG(PSSIVL,0)),"^",3)
118 I PSSIVDEA[1!(PSSIVDEA[2) S PSSIVDO=1 Q
119 I PSSIVDEA[3!(PSSIVDEA[4)!(PSSIVDEA[5) S PSSIVDO=2
120 Q
Note: See TracBrowser for help on using the repository browser.