source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOORRL1.m@ 794

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

initial load of FOIAVistA 6/30/08 version
File size: 4.7 KB
Line 
1PSOORRL1 ;BHAM ISC/SAB,TJH - sub-module for PSOORRL ;01/14/99
2 ;;7.0;OUTPATIENT PHARMACY;**20,46,132,159**;DEC 1997
3 ;External reference to ^PS(51.2 supported by DBIA 2226
4 ;External reference to ^PS(50.607 supported by DBIA 2221
5 ;External reference to ^PS(50.606 supported by DBIA 2174
6 ;External reference to ^PS(51 supported by DBIA 2224
7 ;External reference to ^PS(50.7 supported by DBIA 2223
8 ;External reference to ^PSDRUG supported by DBIA 221
9 ;External reference to ^PS(55 supported by DBIA 2228
10 ;
11MDR ;
12 S ^TMP("PS",$J,"MDR",0)=0,(MDR,MR)=0 F S MR=$O(^PSRX(IFN,"MEDR",MR)) Q:'MR D
13 .Q:'$D(^PS(51.2,+^PSRX(IFN,"MEDR",MR,0),0)) S MDR=MDR+1
14 .I $P($G(^PS(51.2,+^PSRX(IFN,"MEDR",MR,0),0)),"^",3)]"" S ^TMP("PS",$J,"MDR",MDR,0)=$P(^PS(51.2,+^PSRX(IFN,"MEDR",MR,0),0),"^",3)
15 .I $D(^PS(51.2,+^PSRX(IFN,"MEDR",MR,0),0)),$P($G(^(0)),"^",3)']"" S ^TMP("PS",$J,"MDR",MDR,0)=$P(^PS(51.2,+^PSRX(IFN,"MEDR",MR,0),0),"^")
16 .S ^TMP("PS",$J,"MDR",0)=^TMP("PS",$J,"MDR",0)+1
17 Q
18 ;
19PEN ;
20 ;BHW;PSO*7*159;New SD Variable
21 N SD
22 Q:'$D(^PS(52.41,IFN,0))!($P($G(^PS(52.41,IFN,0)),"^",3)="RF") S PSOR=^PS(52.41,IFN,0)
23 S ^TMP("PS",$J,0)=$S($P(PSOR,"^",9):$P($G(^PSDRUG($P(PSOR,"^",9),0)),"^"),1:$P(^PS(50.7,$P(PSOR,"^",8),0),"^")_" "_$P(^PS(50.606,$P(^PS(50.7,$P(PSOR,"^",8),0),"^",2),0),"^"))
24 I $P(PSOR,"^",9) D
25 .S ^TMP("PS",$J,"DD",0)=1
26 .S COD=$S('$G(^PSDRUG($P(PSOR,"^",9),"I")):1,+$G(^PSDRUG($P(PSOR,"^",9),"I"))>DT:1,1:0)
27 .S ^TMP("PS",$J,"DD",1,0)=$P(PSOR,"^",9)_"^^"_$S($P($G(^PSDRUG($P(PSOR,"^",9),2)),"^",3)["U"&(COD):$P(PSOR,"^",9),1:"") K COD
28 S ^TMP("PS",$J,0)=^TMP("PS",$J,0)_"^"_$S($G(^PS(51.2,+$P(PSOR,"^",15),0))]"":$P(^PS(51.2,+$P(PSOR,"^",15),0),"^",3),1:"")_"^^"_$P(PSOR,"^",11)_"^"_$P($P(PSOR,"^",6),".")_"^"_$S($P(PSOR,"^",3)'="HD":"PENDING",1:" ON HOLD")_"^^"_$P(PSOR,"^",10)
29 S $P(^TMP("PS",$J,0),"^",11)=$P(PSOR,"^")
30 S SD=0 F SCH=0:0 S SCH=$O(^PS(52.41,IFN,1,SCH)) Q:'SCH S SD=SD+1,^TMP("PS",$J,"SCH",SD,0)=$P(^PS(52.41,IFN,1,SCH,1),"^"),^TMP("PS",$J,"SCH",0)=SD
31 S SD=0 F SCH=0:0 S SCH=$O(^PS(52.41,IFN,"SIG",SCH)) Q:'SCH S SD=SD+1,^TMP("PS",$J,"SIG",SD,0)=$P(^PS(52.41,IFN,"SIG",SCH,0),"^"),^TMP("PS",$J,"SIG",0)=SD
32 S (IEN,SD)=1,INST=0 F S INST=$O(^PS(52.41,IFN,2,INST)) Q:'INST S (MIG,INST(INST))=^PS(52.41,IFN,2,INST,0),^TMP("PS",$J,"SIO",0)=SD D
33 .F SG=1:1:$L(MIG," ") S:$L($G(^TMP("PS",$J,"SIO",SD,0))_" "_$P(MIG," ",SG))>80 SD=SD+1,^TMP("PS",$J,"SIO",0)=SD S ^TMP("PS",$J,"SIO",SD,0)=$G(^TMP("PS",$J,"SIO",SD,0))_" "_$P(MIG," ",SG)
34END K FL,SD,SCH,%T,Y,ST,ST0,PSBDT,PSEDT,IFN,EXDT,RX0,RX2,RX3,TRM,I,X,Z1,Z0,PSOX1,PSOX2,PSOR,STA,TFN,X1,X2,SC,MDR,MR,IFN,MIG,INST
35 K BDT,EDT,IEN,ITFN,RXNUM
36 Q
37NVA ;non-va meds display
38 Q:'$D(^PS(55,DFN,"NVA",IFN,0))!('$P($G(^PS(55,DFN,"NVA",IFN,0)),"^"))
39 S PSOR=^PS(55,DFN,"NVA",IFN,0)
40 S ^TMP("PS",$J,0)=$S($P(PSOR,"^",2):$P($G(^PSDRUG($P(PSOR,"^",2),0)),"^"),1:$P(^PS(50.7,$P(PSOR,"^"),0),"^")_" "_$P(^PS(50.606,$P(^PS(50.7,$P(PSOR,"^"),0),"^",2),0),"^"))
41 I $P(PSOR,"^",2) D
42 .S ^TMP("PS",$J,"DD",0)=1
43 .S COD=$S('$G(^PSDRUG($P(PSOR,"^",2),"I")):1,+$G(^PSDRUG($P(PSOR,"^",2),"I"))>DT:1,1:0)
44 .S ^TMP("PS",$J,"DD",1,0)=$P(PSOR,"^",2)_"^^"_$S($P($G(^PSDRUG($P(PSOR,"^",2),2)),"^",3)["U"&(COD):$P(PSOR,"^",2),1:"") K COD
45 S ^TMP("PS",$J,0)=^TMP("PS",$J,0)_"^^^N/A^"_$P($P(PSOR,"^",9),".")_"^"_$S('$P(PSOR,"^",7):"ACTIVE",1:"DISCONTINUED")_"^^N/A^^^"_$P(PSOR,"^",8)
46 S ^TMP("PS",$J,"SCH",1,0)=$P(PSOR,"^",5),^TMP("PS",$J,"SCH",0)=1
47 S ^TMP("PS",$J,"SIG",1,0)=$P(PSOR,"^",3)_" "_$P(PSOR,"^",4)_" "_$P(PSOR,"^",5),^TMP("PS",$J,"SIG",0)=1
48 S ^TMP("PS",$J,"SIO",1,0)=$P(PSOR,"^",3)_" "_$P(PSOR,"^",4)_" "_$P(PSOR,"^",5),^TMP("PS",$J,"SIO",0)=1
49 K PSOR
50 Q
51 ;
52SIG ;expands SIG expanded list
53 F Z0=1:1:$L(X," ") G:Z0="" EN S Z1=$P(X," ",Z0) D
54 .D:$D(X)&($G(Z1)]"")
55 ..S Y=$O(^PS(51,"B",Z1,0)) Q:'Y!($P($G(^PS(51,+Y,0)),"^",4)>1) S Z1=$P(^PS(51,Y,0),"^",2) Q:'$D(^(9)) S Y=$P(X," ",Z0-1),Y=$E(Y,$L(Y)) S:Y>1 Z1=^(9)
56 .I $G(^TMP("PS",$J,"SIG",1,0))']"" S ^TMP("PS",$J,"SIG",1,0)=Z1,^TMP("PS",$J,"SIG",0)=1 Q
57 .F PSOX1=0:0 S PSOX1=$O(^TMP("PS",$J,"SIG",PSOX1)) Q:'PSOX1 S PSOX2=PSOX1
58 .I $L(^TMP("PS",$J,"SIG",PSOX2,0))+$L(Z1)<245 S ^TMP("PS",$J,"SIG",PSOX2,0)=^TMP("PS",$J,"SIG",PSOX2,0)_" "_Z1
59 .E S PSOX2=PSOX2+1,^TMP("PS",$J,"SIG",PSOX2,0)=Z1
60EN K Z1,Z0,PSOX1 Q
61 ;
62SIG1 ;expands SIG for condensed list
63 F Z0=1:1:$L(X," ") G:Z0="" EN S Z1=$P(X," ",Z0) D
64 .D:$D(X)&($G(Z1)]"")
65 ..S Y=$O(^PS(51,"B",Z1,0)) Q:'Y!($P($G(^PS(51,+Y,0)),"^",4)>1) S Z1=$P(^PS(51,Y,0),"^",2) Q:'$D(^(9)) S Y=$P(X," ",Z0-1),Y=$E(Y,$L(Y)) S:Y>1 Z1=^(9)
66 .I $G(^TMP("PS",$J,TFN,"SIG",1,0))']"" S ^TMP("PS",$J,TFN,"SIG",1,0)=Z1,^TMP("PS",$J,TFN,"SIG",0)=1 Q
67 .F PSOX1=0:0 S PSOX1=$O(^TMP("PS",$J,TFN,"SIG",PSOX1)) Q:'PSOX1 S PSOX2=PSOX1
68 .I $L(^TMP("PS",$J,TFN,"SIG",PSOX2,0))+$L(Z1)<245 S ^TMP("PS",$J,TFN,"SIG",PSOX2,0)=^TMP("PS",$J,TFN,"SIG",PSOX2,0)_" "_Z1
69 .E S PSOX2=PSOX2+1,^TMP("PS",$J,TFN,"SIG",PSOX2,0)=Z1
70 Q
Note: See TracBrowser for help on using the repository browser.