PSOQ0496 ;BHAM ISC/SAB - returns patient's outpatient meds ; 30 Nov 2007 7:53 AM
;;7.0;OUTPATIENT PHARMACY;**294**;DEC 1997;Build 13
;
;Reference to ^PS(55 supported by DBIA 2228
;Reference to ^PSDRUG supported by DBIA 221
;Reference to ^PS(51.2 supported by DBIA 2226
;Reference to ^PS(50.7 supported by DBIA 2223
;Reference to ^PS(50.606 supported by DBIA 2174
;Reference to OCL^PSJORRE supported by DBIA 2383
;Reference to OEL^PSJORRE1 supported by DBIA 2384
;;LOCAL MOD RMS/HINES 8-27-07, COPY OF PSOORRL TO CONTROL
;;THE BDT VARIABLE USED IN THE NVA SECTION
OCL(DFN,BDT,EDT) ;entry point to return condensed list
;BHW;PSO*7*159;New SD* Variables
N SD,SDT,SDT1
D:$P($G(^PS(55,DFN,0)),"^",6)'=2 EN^PSOHLUP(DFN)
K ^TMP("PS",$J) S TFN=0,PSBDT=$G(BDT),PSEDT=$G(EDT) I +$G(PSBDT)<1 S X1=DT,X2=-120 D C^%DTC S PSBDT=X
S EXDT=PSBDT-1,IFN=0
F S EXDT=$O(^PS(55,DFN,"P","A",EXDT)) Q:'EXDT F S IFN=$O(^PS(55,DFN,"P","A",EXDT,IFN)) Q:'IFN D:$D(^PSRX(IFN,0))
.Q:$P($G(^PSRX(IFN,"STA")),"^")=13
.S TFN=TFN+1,RX0=^PSRX(IFN,0),RX2=$G(^(2)),RX3=$G(^(3)),STA=+$G(^("STA")),TRM=0,LSTFD=$P(RX2,"^",2),LSTRD=$P(RX2,"^",13),LSTDS=$P(RX0,"^",8)
.F I=0:0 S I=$O(^PSRX(IFN,1,I)) Q:'I S TRM=TRM+1,LSTFD=$P(^PSRX(IFN,1,I,0),"^"),LSTDS=$P(^(0),"^",10) S:$P(^(0),"^",18)]"" LSTRD=$P(^(0),"^",18)
.S ^TMP("PS",$J,TFN,0)=IFN_"R;O"_"^"_$P($G(^PSDRUG(+$P(RX0,"^",6),0)),"^")_"^^"_$P(RX2,"^",6)_"^"_($P(RX0,"^",9)-TRM)_"^^^"_$P($G(^PSRX(IFN,"OR1")),"^",2)
.N DIC,X,Y S DIC=200,DIC(0)="N",X="`"_$P(RX0,"^",4) D ^DIC S ^TMP("PS",$J,TFN,"P",0)=Y K DIC,X,Y
.S ST0=$S(STA<12&($P(RX2,"^",6)
80 IEN=IEN+1,SD=SD+1,^TMP("PS",$J,TFN,"SIO",0)=SD S ^TMP("PS",$J,TFN,"SIO",IEN,0)=$G(^TMP("PS",$J,TFN,"SIO",IEN,0))_" "_$P(MIG," ",SG)
D NVA,OCL^PSJORRE(DFN,BDT,EDT,.TFN),END^PSOORRL1
K SDT,SDT1,EDT,EDT1,BDT,DBT1,X
Q
OEL(DFN,RXNUM) ;returns expanded list on specific order
I $P(RXNUM,";",2)="I" D OEL^PSJORRE1(DFN,$P(RXNUM,";")) Q
D:$P($G(^PS(55,DFN,0)),"^",6)'=2 EN^PSOHLUP(DFN) Q:RXNUM=""
;BHW;PSO*7*159;New SD
N SD
K INST,IFN,^TMP("PS",$J) S FL=$P(RXNUM,";"),IFN=+FL,RXNUM=$P(RXNUM,";",2)
I $G(FL)["P"!($G(FL)["S") D PEN^PSOORRL1 Q
I $G(FL)["N" D NVA^PSOORRL1 Q
Q:'$D(^PSRX(IFN,0))
S RX0=^PSRX(IFN,0),RX2=$G(^(2)),RX3=$G(^(3)),STA=+$G(^("STA")),TRM=0,LSTFD=$P(RX2,"^",2)
S ^TMP("PS",$J,"RXN",0)=$P(RX0,"^")_"^"_$E($P(RX2,"^",13),1,7)_"^"_$S($P(RX0,"^",11)="W":"W",1:"M")_"^"_$P(RX3,"^",7)_"^"_$S($P($G(^PSRX(IFN,"OR1")),"^",5):$P(^PSRX(IFN,"OR1"),"^",5),1:"")_"^"_$E($P(RX2,"^",2),1,7)_"^"_$E($P(RX2,"^",13),1,7)
F I=0:0 S I=$O(^PSRX(IFN,1,I)) Q:'I S TRM=TRM+1,LSTFD=$P(^PSRX(IFN,1,I,0),"^") D
.S ^TMP("PS",$J,"REF",I,0)=$P(^PSRX(IFN,1,I,0),"^")_"^"_$P(^(0),"^",10)_"^"_$P(^(0),"^",4)_"^"_$E($P(^(0),"^",18),1,7)_"^"_$S($P(^(0),"^",2)="W":"W",1:"M")_"^"_$P(^(0),"^",3)
.I $P(^PSRX(IFN,1,I,0),"^",18) S $P(^TMP("PS",$J,"RXN",0),"^",2)=$E($P(^PSRX(IFN,1,I,0),"^",18),1,7)
.S ^TMP("PS",$J,"REF",0)=$G(^TMP("PS",$J,"REF",0))+1
F I=0:0 S I=$O(^PSRX(IFN,"P",I)) Q:'I D
.S ^TMP("PS",$J,"PAR",I,0)=$P(^PSRX(IFN,"P",I,0),"^")_"^"_$P(^(0),"^",10)_"^"_$P(^(0),"^",4)_"^"_$E($P(^(0),"^",19),1,7)_"^"_$S($P(^(0),"^",2)="W":"W",1:"M")_"^"_$P(^(0),"^",3)
.S ^TMP("PS",$J,"PAR",0)=$G(^TMP("PS",$J,"PAR",0))+1
S ^TMP("PS",$J,0)=$P($G(^PSDRUG(+$P(RX0,"^",6),0)),"^")_"^^"_$P(RX2,"^",6)
N DIC,X,Y S DIC=200,DIC(0)="N",X="`"_$P(RX0,"^",4) D ^DIC S ^TMP("PS",$J,"P",0)=Y K DIC,X,Y
S ST0=$S(STA<12&($P(RX2,"^",6)DT:1,1:0)
S ^TMP("PS",$J,"DD",1,0)=^TMP("PS",$J,"DD",1,0)_$S($P($G(^PSDRUG(+$P(RX0,"^",6),2)),"^",3)["U"&(COD):$P(RX0,"^",6),1:"") K COD
S ^TMP("PS",$J,"SCH",0)=0,(SCH,SC)=0
F S SC=$O(^PSRX(IFN,"SCH",SC)) Q:'SC S SCH=SCH+1,^TMP("PS",$J,"SCH",SCH,0)=$P(^PSRX(IFN,"SCH",SC,0),"^") D
.S ^TMP("PS",$J,"SCH",0)=^TMP("PS",$J,"SCH",0)+1
D MDR^PSOORRL1
S PSOELSE=0 I $D(^PSRX(IFN,"SIG")),'$P(^PSRX(IFN,"SIG"),"^",2) S PSOELSE=1 S X=$P(^PSRX(IFN,"SIG"),"^") D SIG^PSOORRL1
I '$G(PSOELSE) S ITFN=1 D
.S ^TMP("PS",$J,"SIG",ITFN,0)=$G(^PSRX(IFN,"SIG1",1,0)),^TMP("PS",$J,"SIG",0)=+$G(^TMP("PS",$J,"SIG",0))+1
.F I=1:0 S I=$O(^PSRX(IFN,"SIG1",I)) Q:'I S ITFN=ITFN+1,^TMP("PS",$J,"SIG",ITFN,0)=^PSRX(IFN,"SIG1",I,0),^TMP("PS",$J,"SIG",0)=+$G(^TMP("PS",$J,"SIG",0))+1
K PSOELSE
S ^TMP("PS",$J,"PC",0)=0,ITFN=0
F I=0:0 S I=$O(^PSRX(IFN,"PRC",I)) Q:'I S ITFN=ITFN+1,^TMP("PS",$J,"PC",ITFN,0)=^PSRX(IFN,"PRC",I,0),^TMP("PS",$J,"PC",0)=^TMP("PS",$J,"PC",0)+1
Q
;
WAIT ; IF PENDING ENTRY STILL BEING BUILT SEE IF IT COMPLETES WITHIN ANOTHER SECOND
H 1 S PSOR=$G(^PS(52.41,IFN,0))
Q
;
NVA ; Set Non-VA Med Orders in the ^TMP Global
;BHW;PSO*7*159;New SDT,SDT1 Variables
;LOCAL MOD CHANGES HERE RMS/HINES 8-27-07
;VARIABLE BDT IS PASSED FROM THE TOP, BUT INTERFERES WITH THIS SECTION
N BDT
S BDT=""
N SDT,SDT1
F I=0:0 S I=$O(^PS(55,DFN,"NVA",I)) Q:'I S X=$G(^PS(55,DFN,"NVA",I,0)) D
.Q:'$P(X,"^")
.S DRG=$S($P(X,"^",2):$P($G(^PSDRUG($P(X,"^",2),0)),"^"),1:$P(^PS(50.7,$P(X,"^"),0),"^")_" "_$P(^PS(50.606,$P(^PS(50.7,$P(X,"^"),0),"^",2),0),"^"))
.S SDT=$P(X,"^",9) I 'SDT D TMPBLD Q
.I $E(SDT,4,5),$E(SDT,6,7) D
..;I $P(X,"^",9) D Q
..I $G(BDT),SDTEDT Q
..I $G(BDT),$P(X,"^",7),$P(X,"^",7)EDT1 Q
..I $G(BDT1),$P(X,"^",7),$E($P(X,"^",7),1,5)EDT1 Q
..I $G(BDT1),$P(X,"^",7),$E($P(X,"^",7),1,3)