- PSOORRL3 ;BHAM ISC/SJA - returns patient's outpatient meds-new sort ;02/02/07
- ;;7.0;OUTPATIENT PHARMACY;**225**;DEC 1997;Build 29
- ;External reference to ^PS(55 supported by DBIA 2228
- ;External reference to ^PSDRUG supported by DBIA 221
- ;External reference to ^VA(200 supported by DBIA 10060
- ;External reference to ^PS(51.2 supported by DBIA 2226
- ;External reference to ^PS(50.7 supported by DBIA 2223
- ;External reference to ^PS(50.606 supported by DBIA 2174
- ;External reference to OCL^PSJORRE supported by DBIA 2383
- OCL ;entry point to return condensed list
- ;BHW;PSO*7*159;New SD* Variables
- N SD,SDT,SDT1,PSG,PST,PSD,DRUG,PSOSTA
- D:$P($G(^PS(55,DFN,0)),"^",6)'=2 EN^PSOHLUP(DFN)
- K ^TMP("PS",$J),^TMP("PSO",$J),^TMP("PS1",$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))
- .S PSOSTA=$P($G(^PSRX(IFN,"STA")),"^") Q:'(PSOSTA=0!(PSOSTA=11)!(PSOSTA=5))
- .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 ST0=STA,ST=$P("ERROR^ACTIVE^^^^^ACTIVE/SUSP^^^^^^EXPIRED^^^^^^","^",ST0+2)
- .S DRUG=$P($G(^PSDRUG(+$P(RX0,"^",6),0)),"^")
- .S ^TMP("PSO",$J,DRUG,ST,TFN,0)=IFN_"R;O"_"^"_DRUG_"^^"_$P(RX2,"^",6)_"^"_($P(RX0,"^",9)-TRM)_"^^^"_$P($G(^PSRX(IFN,"OR1")),"^",2)
- .S ^TMP("PSO",$J,DRUG,ST,TFN,"P",0)=$P(RX0,"^",4)_"^"_$P($G(^VA(200,+$P(RX0,"^",4),0)),"^")
- .S ^TMP("PSO",$J,DRUG,ST,TFN,0)=^TMP("PSO",$J,DRUG,ST,TFN,0)_"^"_ST_"^"_LSTFD_"^"_$P(RX0,"^",8)_"^"_$P(RX0,"^",7)_"^^^"_$P(RX0,"^",13)_"^"_LSTRD_"^"_LSTDS
- .S ^TMP("PSO",$J,DRUG,ST,TFN,"SCH",0)=0
- .S (SCH,SC)=0 F S SC=$O(^PSRX(IFN,"SCH",SC)) Q:'SC S SCH=SCH+1,^TMP("PSO",$J,DRUG,ST,TFN,"SCH",SCH,0)=$P(^PSRX(IFN,"SCH",SC,0),"^"),^TMP("PSO",$J,DRUG,ST,TFN,"SCH",0)=^TMP("PSO",$J,DRUG,ST,TFN,"SCH",0)+1
- .S ^TMP("PSO",$J,DRUG,ST,TFN,"MDR",0)=0,(MDR,MR)=0 F S MR=$O(^PSRX(IFN,"MEDR",MR)) Q:'MR D
- ..Q:'$D(^PS(51.2,+^PSRX(IFN,"MEDR",MR,0),0)) S MDR=MDR+1
- ..I $P($G(^PS(51.2,+^PSRX(IFN,"MEDR",MR,0),0)),"^",3)]"" S ^TMP("PSO",$J,DRUG,ST,TFN,"MDR",MDR,0)=$P(^PS(51.2,+^PSRX(IFN,"MEDR",MR,0),0),"^",3)
- ..I $D(^PS(51.2,+^PSRX(IFN,"MEDR",MR,0),0)),$P($G(^(0)),"^",3)']"" S ^TMP("PSO",$J,DRUG,ST,TFN,"MDR",MDR,0)=$P(^PS(51.2,+^PSRX(IFN,"MEDR",MR,0),0),"^")
- ..S ^TMP("PSO",$J,DRUG,ST,TFN,"MDR",0)=^TMP("PSO",$J,DRUG,ST,TFN,"MDR",0)+1
- .S PSOELSE=0 I $D(^PSRX(IFN,"SIG")),'$P(^PSRX(IFN,"SIG"),"^",2) S PSOELSE=1 S X=$P(^PSRX(IFN,"SIG"),"^") D SIG1^PSOORRL1
- .I '$G(PSOELSE) S ITFN=1 D
- ..S ^TMP("PSO",$J,DRUG,ST,TFN,"SIG",ITFN,0)=$G(^PSRX(IFN,"SIG1",1,0)),^TMP("PSO",$J,DRUG,ST,TFN,"SIG",0)=+$G(^TMP("PSO",$J,DRUG,ST,TFN,"SIG",0))+1
- ..F I=1:0 S I=$O(^PSRX(IFN,"SIG1",I)) Q:'I S ITFN=ITFN+1,^TMP("PSO",$J,DRUG,ST,TFN,"SIG",ITFN,0)=^PSRX(IFN,"SIG1",I,0),^TMP("PSO",$J,DRUG,ST,TFN,"SIG",0)=+$G(^TMP("PSO",$J,DRUG,ST,TFN,"SIG",0))+1
- K PSOELSE D NVA
- S PSG="",J=1 F S PSG=$O(^TMP("PSO",$J,PSG)) Q:PSG="" S PST="" F S PST=$O(^TMP("PSO",$J,PSG,PST)) Q:PST="" S I=0 F S I=$O(^TMP("PSO",$J,PSG,PST,I)) Q:'I D
- .M ^TMP("PS",$J,J)=^TMP("PSO",$J,PSG,PST,I) S J=J+1
- S PSG="" F S PSG=$O(^TMP("PS1",$J,PSG)) Q:PSG="" S PST="" F S PST=$O(^TMP("PS1",$J,PSG,PST)) Q:PST="" S I=0 F S I=$O(^TMP("PS1",$J,PSG,PST,I)) Q:I="" D
- .M ^TMP("PS",$J,J)=^TMP("PS1",$J,PSG,PST,I) S J=J+1
- K ^TMP("PSO",$J),^TMP("PS1",$J)
- D OCL^PSJORRE(DFN,BDT,EDT,.TFN,+$G(VIEW)) D END^PSOORRL1
- K SDT,SDT1,ST,DRUG,PSG,PST,PSD,EDT,EDT1,BDT,DBT1,X
- Q
- NVA ; Set Non-VA Med Orders in the ^TMP Global
- ;BHW;PSO*7*159;New SDT,SDT1 Variables
- 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,"^")!($P(X,"^",7))
- .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),SDT<BDT Q
- ..I $G(EDT),SDT>EDT Q
- ..I $G(BDT),$P(X,"^",7),$P(X,"^",7)<BDT Q
- ..D TMPBLD
- .I $E(SDT,4,5),'$E(SDT,6,7) D
- ..S SDT1=$E(SDT,1,5),BDT1=$E(+$G(BDT),1,5),EDT1=$E(+$G(EDT),1,5)
- ..I $G(BDT1),SDT1<BDT1 Q
- ..I $G(EDT1),SDT1>EDT1 Q
- ..I $G(BDT1),$P(X,"^",7),$E($P(X,"^",7),1,5)<BDT1 Q
- ..D TMPBLD
- .I '$E(SDT,4,5),'$E($P(X,"^",9),6,7) D
- ..;I $P(X,"^",9) D Q
- ..S SDT1=$E(SDT,1,3),BDT1=$E(+$G(BDT),1,3),EDT1=$E(+$G(EDT),1,3)
- ..I $G(BDT1),SDT1<BDT1 Q
- ..I $G(EDT1),SDT1>EDT1 Q
- ..I $G(BDT1),$P(X,"^",7),$E($P(X,"^",7),1,3)<BDT1 Q
- ..D TMPBLD
- Q
- TMPBLD S TFN=$G(TFN)+1,ST="ACTIVE"
- S ^TMP("PS1",$J,DRG,ST,TFN,0)=I_"N;O^"_DRG
- S $P(^TMP("PS1",$J,DRG,ST,TFN,0),"^",8)=$P(X,"^",8)_"^"_$S($P(X,"^",7):"DISCONTINUED",1:"ACTIVE")
- S ^TMP("PS1",$J,DRG,ST,TFN,"SCH",0)=1,^TMP("PS1",$J,DRG,ST,TFN,"SCH",1,0)=$P(X,"^",5)
- S ^TMP("PS1",$J,DRG,ST,TFN,"SIG",0)=1,^TMP("PS1",$J,DRG,ST,TFN,"SIG",1,0)=$P(X,"^",3)_" "_$P(X,"^",4)_" "_$P(X,"^",5)
- Q
- PSOORRL3 ;BHAM ISC/SJA - returns patient's outpatient meds-new sort ;02/02/07
- +1 ;;7.0;OUTPATIENT PHARMACY;**225**;DEC 1997;Build 29
- +2 ;External reference to ^PS(55 supported by DBIA 2228
- +3 ;External reference to ^PSDRUG supported by DBIA 221
- +4 ;External reference to ^VA(200 supported by DBIA 10060
- +5 ;External reference to ^PS(51.2 supported by DBIA 2226
- +6 ;External reference to ^PS(50.7 supported by DBIA 2223
- +7 ;External reference to ^PS(50.606 supported by DBIA 2174
- +8 ;External reference to OCL^PSJORRE supported by DBIA 2383
- OCL ;entry point to return condensed list
- +1 ;BHW;PSO*7*159;New SD* Variables
- +2 NEW SD,SDT,SDT1,PSG,PST,PSD,DRUG,PSOSTA
- +3 IF $PIECE($GET(^PS(55,DFN,0)),"^",6)'=2
- DO EN^PSOHLUP(DFN)
- +4 KILL ^TMP("PS",$JOB),^TMP("PSO",$JOB),^TMP("PS1",$JOB)
- +5 SET TFN=0
- SET PSBDT=$GET(BDT)
- SET PSEDT=$GET(EDT)
- IF +$GET(PSBDT)<1
- SET X1=DT
- SET X2=-120
- DO C^%DTC
- SET PSBDT=X
- +6 SET EXDT=PSBDT-1
- SET IFN=0
- +7 FOR
- SET EXDT=$ORDER(^PS(55,DFN,"P","A",EXDT))
- IF 'EXDT
- QUIT
- FOR
- SET IFN=$ORDER(^PS(55,DFN,"P","A",EXDT,IFN))
- IF 'IFN
- QUIT
- IF $DATA(^PSRX(IFN,0))
- Begin DoDot:1
- +8 SET PSOSTA=$PIECE($GET(^PSRX(IFN,"STA")),"^")
- IF '(PSOSTA=0!(PSOSTA=11)!(PSOSTA=5))
- QUIT
- +9 SET TFN=TFN+1
- SET RX0=^PSRX(IFN,0)
- SET RX2=$GET(^(2))
- SET RX3=$GET(^(3))
- SET STA=+$GET(^("STA"))
- SET TRM=0
- SET LSTFD=$PIECE(RX2,"^",2)
- SET LSTRD=$PIECE(RX2,"^",13)
- SET LSTDS=$PIECE(RX0,"^",8)
- +10 FOR I=0:0
- SET I=$ORDER(^PSRX(IFN,1,I))
- IF 'I
- QUIT
- SET TRM=TRM+1
- SET LSTFD=$PIECE(^PSRX(IFN,1,I,0),"^")
- SET LSTDS=$PIECE(^(0),"^",10)
- IF $PIECE(^(0),"^",18)]""
- SET LSTRD=$PIECE(^(0),"^",18)
- +11 SET ST0=STA
- SET ST=$PIECE("ERROR^ACTIVE^^^^^ACTIVE/SUSP^^^^^^EXPIRED^^^^^^","^",ST0+2)
- +12 SET DRUG=$PIECE($GET(^PSDRUG(+$PIECE(RX0,"^",6),0)),"^")
- +13 SET ^TMP("PSO",$JOB,DRUG,ST,TFN,0)=IFN_"R;O"_"^"_DRUG_"^^"_$PIECE(RX2,"^",6)_"^"_($PIECE(RX0,"^",9)-TRM)_"^^^"_$PIECE($GET(^PSRX(IFN,"OR1")),"^",2)
- +14 SET ^TMP("PSO",$JOB,DRUG,ST,TFN,"P",0)=$PIECE(RX0,"^",4)_"^"_$PIECE($GET(^VA(200,+$PIECE(RX0,"^",4),0)),"^")
- +15 SET ^TMP("PSO",$JOB,DRUG,ST,TFN,0)=^TMP("PSO",$JOB,DRUG,ST,TFN,0)_"^"_ST_"^"_LSTFD_"^"_$PIECE(RX0,"^",8)_"^"_$PIECE(RX0,"^",7)_"^^^"_$PIECE(RX0,"^",13)_"^"_LSTRD_"^"_LSTDS
- +16 SET ^TMP("PSO",$JOB,DRUG,ST,TFN,"SCH",0)=0
- +17 SET (SCH,SC)=0
- FOR
- SET SC=$ORDER(^PSRX(IFN,"SCH",SC))
- IF 'SC
- QUIT
- SET SCH=SCH+1
- SET ^TMP("PSO",$JOB,DRUG,ST,TFN,"SCH",SCH,0)=$PIECE(^PSRX(IFN,"SCH",SC,0),"^")
- SET ^TMP("PSO",$JOB,DRUG,ST,TFN,"SCH",0)=^TMP("PSO",$JOB,DRUG,ST,TFN,"SCH",0)+1
- +18 SET ^TMP("PSO",$JOB,DRUG,ST,TFN,"MDR",0)=0
- SET (MDR,MR)=0
- FOR
- SET MR=$ORDER(^PSRX(IFN,"MEDR",MR))
- IF 'MR
- QUIT
- Begin DoDot:2
- +19 IF '$DATA(^PS(51.2,+^PSRX(IFN,"MEDR",MR,0),0))
- QUIT
- SET MDR=MDR+1
- +20 IF $PIECE($GET(^PS(51.2,+^PSRX(IFN,"MEDR",MR,0),0)),"^",3)]""
- SET ^TMP("PSO",$JOB,DRUG,ST,TFN,"MDR",MDR,0)=$PIECE(^PS(51.2,+^PSRX(IFN,"MEDR",MR,0),0),"^",3)
- +21 IF $DATA(^PS(51.2,+^PSRX(IFN,"MEDR",MR,0),0))
- IF $PIECE($GET(^(0)),"^",3)']""
- SET ^TMP("PSO",$JOB,DRUG,ST,TFN,"MDR",MDR,0)=$PIECE(^PS(51.2,+^PSRX(IFN,"MEDR",MR,0),0),"^")
- +22 SET ^TMP("PSO",$JOB,DRUG,ST,TFN,"MDR",0)=^TMP("PSO",$JOB,DRUG,ST,TFN,"MDR",0)+1
- End DoDot:2
- +23 SET PSOELSE=0
- IF $DATA(^PSRX(IFN,"SIG"))
- IF '$PIECE(^PSRX(IFN,"SIG"),"^",2)
- SET PSOELSE=1
- SET X=$PIECE(^PSRX(IFN,"SIG"),"^")
- DO SIG1^PSOORRL1
- +24 IF '$GET(PSOELSE)
- SET ITFN=1
- Begin DoDot:2
- +25 SET ^TMP("PSO",$JOB,DRUG,ST,TFN,"SIG",ITFN,0)=$GET(^PSRX(IFN,"SIG1",1,0))
- SET ^TMP("PSO",$JOB,DRUG,ST,TFN,"SIG",0)=+$GET(^TMP("PSO",$JOB,DRUG,ST,TFN,"SIG",0))+1
- +26 FOR I=1:0
- SET I=$ORDER(^PSRX(IFN,"SIG1",I))
- IF 'I
- QUIT
- SET ITFN=ITFN+1
- SET ^TMP("PSO",$JOB,DRUG,ST,TFN,"SIG",ITFN,0)=^PSRX(IFN,"SIG1",I,0)
- SET ^TMP("PSO",$JOB,DRUG,ST,TFN,"SIG",0)=+$GET(^TMP("PSO",$JOB,DRUG,ST,TFN,"SIG",0))+1
- End DoDot:2
- End DoDot:1
- +27 KILL PSOELSE
- DO NVA
- +28 SET PSG=""
- SET J=1
- FOR
- SET PSG=$ORDER(^TMP("PSO",$JOB,PSG))
- IF PSG=""
- QUIT
- SET PST=""
- FOR
- SET PST=$ORDER(^TMP("PSO",$JOB,PSG,PST))
- IF PST=""
- QUIT
- SET I=0
- FOR
- SET I=$ORDER(^TMP("PSO",$JOB,PSG,PST,I))
- IF 'I
- QUIT
- Begin DoDot:1
- +29 MERGE ^TMP("PS",$JOB,J)=^TMP("PSO",$JOB,PSG,PST,I)
- SET J=J+1
- End DoDot:1
- +30 SET PSG=""
- FOR
- SET PSG=$ORDER(^TMP("PS1",$JOB,PSG))
- IF PSG=""
- QUIT
- SET PST=""
- FOR
- SET PST=$ORDER(^TMP("PS1",$JOB,PSG,PST))
- IF PST=""
- QUIT
- SET I=0
- FOR
- SET I=$ORDER(^TMP("PS1",$JOB,PSG,PST,I))
- IF I=""
- QUIT
- Begin DoDot:1
- +31 MERGE ^TMP("PS",$JOB,J)=^TMP("PS1",$JOB,PSG,PST,I)
- SET J=J+1
- End DoDot:1
- +32 KILL ^TMP("PSO",$JOB),^TMP("PS1",$JOB)
- +33 DO OCL^PSJORRE(DFN,BDT,EDT,.TFN,+$GET(VIEW))
- DO END^PSOORRL1
- +34 KILL SDT,SDT1,ST,DRUG,PSG,PST,PSD,EDT,EDT1,BDT,DBT1,X
- +35 QUIT
- NVA ; Set Non-VA Med Orders in the ^TMP Global
- +1 ;BHW;PSO*7*159;New SDT,SDT1 Variables
- +2 NEW SDT,SDT1
- +3 FOR I=0:0
- SET I=$ORDER(^PS(55,DFN,"NVA",I))
- IF 'I
- QUIT
- SET X=$GET(^PS(55,DFN,"NVA",I,0))
- Begin DoDot:1
- +4 IF '$PIECE(X,"^")!($PIECE(X,"^",7))
- QUIT
- +5 SET DRG=$SELECT($PIECE(X,"^",2):$PIECE($GET(^PSDRUG($PIECE(X,"^",2),0)),"^"),1:$PIECE(^PS(50.7,$PIECE(X,"^"),0),"^")_" "_$PIECE(^PS(50.606,$PIECE(^PS(50.7,$PIECE(X,"^"),0),"^",2),0),"^"))
- +6 SET SDT=$PIECE(X,"^",9)
- IF 'SDT
- DO TMPBLD
- QUIT
- +7 IF $EXTRACT(SDT,4,5)
- IF $EXTRACT(SDT,6,7)
- Begin DoDot:2
- +8 ;I $P(X,"^",9) D Q
- +9 IF $GET(BDT)
- IF SDT<BDT
- QUIT
- +10 IF $GET(EDT)
- IF SDT>EDT
- QUIT
- +11 IF $GET(BDT)
- IF $PIECE(X,"^",7)
- IF $PIECE(X,"^",7)<BDT
- QUIT
- +12 DO TMPBLD
- End DoDot:2
- +13 IF $EXTRACT(SDT,4,5)
- IF '$EXTRACT(SDT,6,7)
- Begin DoDot:2
- +14 SET SDT1=$EXTRACT(SDT,1,5)
- SET BDT1=$EXTRACT(+$GET(BDT),1,5)
- SET EDT1=$EXTRACT(+$GET(EDT),1,5)
- +15 IF $GET(BDT1)
- IF SDT1<BDT1
- QUIT
- +16 IF $GET(EDT1)
- IF SDT1>EDT1
- QUIT
- +17 IF $GET(BDT1)
- IF $PIECE(X,"^",7)
- IF $EXTRACT($PIECE(X,"^",7),1,5)<BDT1
- QUIT
- +18 DO TMPBLD
- End DoDot:2
- +19 IF '$EXTRACT(SDT,4,5)
- IF '$EXTRACT($PIECE(X,"^",9),6,7)
- Begin DoDot:2
- +20 ;I $P(X,"^",9) D Q
- +21 SET SDT1=$EXTRACT(SDT,1,3)
- SET BDT1=$EXTRACT(+$GET(BDT),1,3)
- SET EDT1=$EXTRACT(+$GET(EDT),1,3)
- +22 IF $GET(BDT1)
- IF SDT1<BDT1
- QUIT
- +23 IF $GET(EDT1)
- IF SDT1>EDT1
- QUIT
- +24 IF $GET(BDT1)
- IF $PIECE(X,"^",7)
- IF $EXTRACT($PIECE(X,"^",7),1,3)<BDT1
- QUIT
- +25 DO TMPBLD
- End DoDot:2
- End DoDot:1
- +26 QUIT
- TMPBLD SET TFN=$GET(TFN)+1
- SET ST="ACTIVE"
- +1 SET ^TMP("PS1",$JOB,DRG,ST,TFN,0)=I_"N;O^"_DRG
- +2 SET $PIECE(^TMP("PS1",$JOB,DRG,ST,TFN,0),"^",8)=$PIECE(X,"^",8)_"^"_$SELECT($PIECE(X,"^",7):"DISCONTINUED",1:"ACTIVE")
- +3 SET ^TMP("PS1",$JOB,DRG,ST,TFN,"SCH",0)=1
- SET ^TMP("PS1",$JOB,DRG,ST,TFN,"SCH",1,0)=$PIECE(X,"^",5)
- +4 SET ^TMP("PS1",$JOB,DRG,ST,TFN,"SIG",0)=1
- SET ^TMP("PS1",$JOB,DRG,ST,TFN,"SIG",1,0)=$PIECE(X,"^",3)_" "_$PIECE(X,"^",4)_" "_$PIECE(X,"^",5)
- +5 QUIT
