source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOORAPI.m@ 1305

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

initial load of WorldVistAEHR

File size: 3.8 KB
RevLine 
[613]1PSOORAPI ;BIR/RTR-API utility routine ;7/8/00
2 ;;7.0;OUTPATIENT PHARMACY;**45,58**;DEC 1997
3 ;External reference to ^PSDRUG supported by DBIA 221
4 ;External reference to $$ZIEN^A7RPSOUB supported by DBIA 3314
5 ;
6EN(PSOB,PSOE,PSOX,PSODT,PSON) ;
7 ;PSOB - begin date
8 ;PSOE - end date
9 ;PSOX - medication array
10 ;PSODT - fill or release date
11 ;PSON - node subscript
12 ;
13 N PSORD,PSORX,PSOFILL,PSODRG,PSOND,PSOPDFN,PSOCX,PSOMED1,PSOMED2,PSODNM,PSOPRT,PSODAYS,PSOCSITE,PSONOC,PSORTN,PSORXIEN
14 Q:'$G(PSOB)!('$G(PSOE))
15 Q:$G(PSODT)'="F"&($G(PSODT)'="R")
16 S PSOB=PSOB-.0001,PSOE=PSOE+.999999
17 Q:$G(PSON)=""
18 S PSOCSITE=+$P($$SITE^VASITE(),"^",3)
19 S PSORTN=0 I $T(ZIEN52^A7RPSOUB)]"" S PSORTN=1
20 K ^TMP(PSON,$J),^TMP($J,"PSOCT")
21 G:PSODT="F" FILL
22REL ;Use release date
23 K PSOPRT
24 F PSORD=PSOB:0 S PSORD=$O(^PSRX("AL",PSORD)) Q:'PSORD!(PSORD>PSOE) F PSORX=0:0 S PSORX=$O(^PSRX("AL",PSORD,PSORX)) Q:'PSORX S PSOFILL="" F S PSOFILL=$O(^PSRX("AL",PSORD,PSORX,PSOFILL)) Q:PSOFILL="" D
25 .D SET
26 .Q:'$G(PSODRG)!('$G(PSOPDFN))
27 .D MED
28 ;Partial releases
29 S PSOPRT=1
30 F PSORD=PSOB:0 S PSORD=$O(^PSRX("AM",PSORD)) Q:'PSORD!(PSORD>PSOE) F PSORX=0:0 S PSORX=$O(^PSRX("AM",PSORD,PSORX)) Q:'PSORX S PSOFILL="" F S PSOFILL=$O(^PSRX("AM",PSORD,PSORX,PSOFILL)) Q:PSOFILL="" D
31 .D SET
32 .Q:'$G(PSODRG)!('$G(PSOPDFN))
33 .D MED
34 G END
35FILL ;Use fill date
36 K PSOPRT
37 F PSORD=PSOB:0 S PSORD=$O(^PSRX("AD",PSORD)) Q:'PSORD!(PSORD>PSOE) F PSORX=0:0 S PSORX=$O(^PSRX("AD",PSORD,PSORX)) Q:'PSORX S PSOFILL="" F S PSOFILL=$O(^PSRX("AD",PSORD,PSORX,PSOFILL)) Q:PSOFILL="" D
38 .D SET
39 .Q:'$G(PSODRG)!('$G(PSOPDFN))
40 .D MED
41 ;Partial fills
42 S PSOPRT=1
43 F PSORD=PSOB:0 S PSORD=$O(^PSRX("ADP",PSORD)) Q:'PSORD!(PSORD>PSOE) F PSORX=0:0 S PSORX=$O(^PSRX("ADP",PSORD,PSORX)) Q:'PSORX S PSOFILL="" F S PSOFILL=$O(^PSRX("ADP",PSORD,PSORX,PSOFILL)) Q:PSOFILL="" D
44 .D SET
45 .Q:'$G(PSODRG)!('$G(PSOPDFN))
46 .D MED
47 G END
48SET ;
49 K PSOND,PSODNM,PSODAYS S PSODRG=+$P($G(^PSRX(PSORX,0)),"^",6),PSOPDFN=+$P($G(^(0)),"^",2) I PSODRG S PSOND=+$P($G(^PSDRUG(PSODRG,"ND")),"^"),PSODNM=$P($G(^(0)),"^")
50 I $G(PSOPRT) S PSODAYS=$P($G(^PSRX(PSORX,"P",+$G(PSOFILL),0)),"^",10)
51 I '$G(PSOPRT) S PSODAYS=$S($G(PSOFILL):$P($G(^PSRX(PSORX,1,+$G(PSOFILL),0)),"^",10),1:$P($G(^PSRX(PSORX,0)),"^",8))
52 Q
53MED ;Check medication array for matches
54 K PSOMED1,PSOMED2,PSOMED3
55 I $D(PSOX(PSODRG_";PSDRUG(")) S PSOMED1=1 D MEDS Q
56 I $G(PSOND),$D(PSOX(PSOND_";PSNDF(50.6,")) S PSOMED2=1 D MEDS Q
57 ;Here, add class check when ready, use PSOMED2 for NDF, default to 1 for VA Class in MEDS
58 Q
59MEDS ;
60 S PSONOC=0 I '$G(PSOPRT),'$G(PSOFILL),$G(PSORTN),$G(PSOCSITE) S PSORXIEN=$P($G(^PSRX(PSORX,0)),"^") I $G(PSORXIEN)'="" S PSONOC=$$ZIEN52^A7RPSOUB(PSOCSITE,PSORXIEN)
61 Q:$G(PSONOC)
62 I $D(^TMP($J,"PSOCT",PSOPDFN)) S (PSOCX,^TMP($J,"PSOCT",PSOPDFN))=^TMP($J,"PSOCT",PSOPDFN)+1
63 I '$D(^TMP($J,"PSOCT",PSOPDFN)) S (PSOCX,^TMP($J,"PSOCT",PSOPDFN))=1
64 S ^TMP(PSON,$J,PSOPDFN,PSOCX,0)=$S($G(PSOMED1):PSODRG_";PSDRUG(",1:$G(PSOND)_";PSNDF(50.6,")
65 I $G(PSODT)="F" D Q
66 .I '$G(PSOPRT) S ^TMP(PSON,$J,PSOPDFN,PSOCX,1)=PSORD_"^"_$S('$G(PSOFILL)&($P($G(^PSRX(PSORX,2)),"^",13)):$E($P($G(^(2)),"^",13),1,7),$G(PSOFILL)&($P($G(^PSRX(PSORX,1,$G(PSOFILL),0)),"^",18)):$E($P($G(^(0)),"^",18),1,7),1:"")_"^"_$G(PSODNM)
67 .I $G(PSOPRT) S ^TMP(PSON,$J,PSOPDFN,PSOCX,1)=PSORD_"^"_$S($G(PSOFILL)&($P($G(^PSRX(PSORX,"P",$G(PSOFILL),0)),"^",19)):$E($P($G(^(0)),"^",19),1,7),1:"")_"^"_$G(PSODNM)
68 .S ^TMP(PSON,$J,PSOPDFN,PSOCX,1)=$G(^TMP(PSON,$J,PSOPDFN,PSOCX,1))_"^"_$G(PSODAYS)
69 S ^TMP(PSON,$J,PSOPDFN,PSOCX,1)=$S('$G(PSOPRT)&('$G(PSOFILL)):$E($P($G(^PSRX(PSORX,2)),"^",2),1,7),'$G(PSOPRT)&($G(PSOFILL)):$E($P($G(^PSRX(PSORX,1,+$G(PSOFILL),0)),"^"),1,7),$G(PSOPRT):$E($P($G(^PSRX(PSORX,"P",+$G(PSOFILL),0)),"^"),1,7),1:"")
70 S ^TMP(PSON,$J,PSOPDFN,PSOCX,1)=$G(^TMP(PSON,$J,PSOPDFN,PSOCX,1))_"^"_$E($G(PSORD),1,7)_"^"_$G(PSODNM)_"^"_$G(PSODAYS)
71 Q
72END ;
73 K ^TMP($J,"PSOCT")
74 Q
Note: See TracBrowser for help on using the repository browser.