- PSOORDER ;BHAM ISC/SAB- utility routine to return Rx data ; 04/09/96 10:30 am
- ;;7.0;OUTPATIENT PHARMACY;**11,20,9,46,103**;DEC 1997
- ;External reference to File #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 ^SC supported by DBIA 10040
- ;External reference to ^DPT supported by DBIA 10035
- ;External reference to ^PSNAPIS supported by DBIA 2531
- ;External reference to ^PSNDF supported by DBIA 2195
- ;External reference to ^PS(50.7 supported by DBIA 2223
- ;External reference to ^PS(50.606 supported by DBIA 2174
- ;data returned
- ;^tmp("psor",$j,rxn,0)=id^fd^lsfd^st^rx#^qty^ds^rf^rfm^drct^rxct^exdt^reldt^rtsdt^wpc^dfn
- ;
- ;if status equals Hold: ^tmp("psor",$j,rxn,"hold",0)=hdrs^hdcom^hddt
- ;if the rx has an entry in the suspense file (#52.5) ^tmp("psor",$j,rxn,"sus",0)=prt^cmind
- ;^tmp("psor",$j,rxn,1)= pr^clk^vrp^cln^rxp^mw^div^oerr#
- ;
- ;cmop data: If applicable
- ;^tmp("psor",$j,rxn,"cmop",n,0)=trans #^seq #^fill #^cmsta^cmdc dt^ndc
- ;^tmp("psor",$j,rx,"cmop",1,1,0)=cmdc reason
- ;
- ;^tmp("psor",$j,rxn,"drug",0)=dr^va print name^drug id^va drug class
- ;^tmp("psor",$j,rxn,"drugoi",0)=orderable item
- ;^tmp("psor",$j,rxn,"ib",0)=copay transaction type^ib number
- ;^tmp("psor",$j,rxn,"ref",n,0)=rfd^pr^clk^qty^ds^drct^rxct^reldt^rstdt^m/w^div ;refill data
- ;;^tmp("psor",$j,rxn,"act",n,0)=d/t^rea^new person^rx #^comments
- ;^tmp("psor",$j,rxn,"rpar",n,0)=prd^pr^clk^qty^ds^drct^rxct^reldt^rstdt^m/w^div ;partial fill data
- ;^tmp("psor",$j,rxn,"sig",n,0)=condensed medication instructions (SIG)
- ;^tmp("psor",$j,rxn,"sig1",n,0)=expanded medication instructions (SIG)
- ;^tmp("psor",$j,rxn,"act",n,0)=d/t^rea^new person^filltype^comments pso*7*20
- ;
- ;for full break down of data returned see DBIA #1878
- ;
- EN(DFN,RX) ;
- K ^TMP("PSOR",$J)
- N SIG,SG,IEN,CMOP,CMIN,CMIND,HDST,I,LSFD,PSO2,PSOCF,PSOCST,PSODR,PSODT,PSOLFD,PSOFD,PSOID,PSOJ,PSOPR,PSOPLCL,PSOPLPR,PSOREF,PSORF,PSORFCL,PSORFPR,PSOST,PSOX,RX0,RX0,RX1,RX3,RX3,RXH,RXP,ST0,SUS
- Q:'$D(^PSRX(RX,0))!('$D(^PSRX(RX,2)))!('$D(^PSRX(RX,3)))!($G(^PSRX(RX,"STA"))=13)
- I $G(DFN)'="",$P($G(^PSRX(RX,0)),"^",2)'=$G(DFN) Q
- I '$G(DFN) S DFN=+$P($G(^PSRX(RX,0)),"^",2)
- K PSOLOUD D:$P($G(^PS(55,DFN,0)),"^",6)'=2 EN^PSOHLUP(DFN)
- S:$G(^PSRX(RX,"IB"))]"" ^TMP("PSOR",$J,RX,"IB")=$P(^PSRX(RX,"IB"),"^",1,2)
- S RX0=^PSRX(RX,0),RX2=^(2),RX3=^(3),RXH=$G(^("H")),PSORF=$P(RX0,"^",9),LSFD=$P(RX2,"^",2),ST0=$P($G(^("STA")),"^"),OERR=$G(^("OR1")) D
- .F I=0:0 S I=$O(^PSRX(RX,1,I)) Q:'I I $D(^PSRX(RX,1,I,0)) S RX1(I)=^PSRX(RX,1,I,0),PSORF=PSORF-1,LSFD=+RX1(I),PSOCST=$P(RX1(I),"^",4)*+$P(RX1(I),"^",11) D
- ..S PSORFPR=$P(RX0,"^",4) I PSORFPR S PSORFPR=PSORFPR_";"_$P($G(^VA(200,PSORFPR,0)),"^")
- ..S PSORFCL=$P(RX1(I),"^",7) I PSORFCL S PSORFCL=PSORFCL_";"_$P($G(^VA(200,PSORFCL,0)),"^")
- ..S ^TMP("PSOR",$J,RX,"REF",I,0)=+RX1(I)_"^"_$G(PSORFPR)_"^"_$G(PSORFCL)_"^"_$P(RX1(I),"^",4)_"^"_+$P(RX1(I),"^",10)_"^"_+$P(RX1(I),"^",11)_"^"
- ..S ^TMP("PSOR",$J,RX,"REF",I,0)=^TMP("PSOR",$J,RX,"REF",I,0)_PSOCST_"^"_$P(RX1(I),"^",18)_"^"_$P(RX1(I),"^",16)_"^"_$S($P(RX1(I),"^",2)="M":"M;MAIL",1:"W;WINDOW")_"^"_$P(RX1(I),"^",9)
- .F I=0:0 S I=$O(^PSRX(RX,"P",I)) Q:'I I $D(^PSRX(RX,"P",I,0)) S RXP(I)=^PSRX(RX,"P",I,0) D
- ..S PSOCST=$P(RXP(I),"^",4)*+$P(RXP(I),"^",11)
- ..S PSOPLPR=$P(RX0,"^",4) I PSOPLPR S PSOPLPR=PSOPLPR_";"_$P($G(^VA(200,PSOPLPR,0)),"^")
- ..S PSOPLCL=$P(RXP(I),"^",7) I PSOPLCL S PSOPLCL=PSOPLCL_";"_$P($G(^VA(200,PSOPLCL,0)),"^")
- ..S ^TMP("PSOR",$J,RX,"RPAR",I,0)=+RXP(I)_"^"_$G(PSOPLPR)_"^"_$G(PSOPLCL)_"^"_$P(RXP(I),"^",4)_"^"_+$P(RXP(I),"^",10)_"^"
- ..S ^TMP("PSOR",$J,RX,"RPAR",I,0)=^TMP("PSOR",$J,RX,"RPAR",I,0)_+$P(RXP(I),"^",11)_"^"_PSOCST_"^"_$P(RXP(I),"^",19)_"^"_$P(RXP(I),"^",16)_"^"_$S($P(RXP(I),"^",2)="M":"M;MAIL",1:"W;WINDOW")_"^"_$P(RXP(I),"^",9)
- S PSOLFD=+$G(RX3),PSODR=+$P(RX0,"^",6),PSOPR=$P(RX0,"^",4),PSOREF=$P(RX0,"^",9),PSOID=$P(RX0,"^",13),PSOST=$P($G(^PSRX(RX,"STA")),"^"),PSODT=$P(RX2,"^",6)
- D ODT S PSOFD=$P(RX2,"^",2),PSOX=$S($D(^PSDRUG(PSODR,0)):$P(^(0),"^"),1:"NOT ON FILE"),PSODR=PSODR_";"_PSOX
- S PSOPR=$P(RX0,"^",4) I PSOPR S PSOX=$G(^VA(200,PSOPR,0)) S PSOPR=PSOPR_";"_$P(PSOX,"^")
- S CLK=$P(RX0,"^",16) I CLK S PSOX=$G(^VA(200,CLK,0)) S CLK=CLK_";"_$P(PSOX,"^")
- S VPR=$P(RX2,"^",10) I VPR S PSOX=$G(^VA(200,VPR,0)) S VPR=VPR_";"_$P(PSOX,"^")
- S CLN=$P(RX0,"^",5) I CLN S PSOX=$G(^SC(CLN,0)) S CLN=CLN_";"_$P(PSOX,"^")
- S RXP=$P(RX0,"^",3)_";"_$P($G(^PS(53,+$P(RX0,"^",3),0)),"^")
- S MW=$S($P(RX0,"^",11)="W":"W;WINDOW",1:"M;MAIL")
- S PSOX="A;ACTIVE" S:$D(^PS(52.4,RX,0)) PSOX="N;NON-VERIFIED" S:$O(^PS(52.5,"B",RX,0))&($G(^PS(52.5,+$O(^PS(52.5,"B",RX,0)),"P"))'=1) PSOX="S;SUSPENDED"
- I ST0<12,$P(RX2,"^",6)<DT S ST0=11
- S PSOX=$P("Error^A;Active^N;Non-Verified^R;Refill^H;Hold^N;Non-Verified^S;Suspended^^^^^D;Done^E;Expired^DC;Discontinued^D;Deleted^DC;Discontinued^DC;Discontinued (Edit)^H;Provider Hold^","^",ST0+2)
- D:PSOX="H;Hold"
- .S RXH=$G(^PSRX(RX,"H"))
- .S HDST=$S(+RXH=1:"Insufficient QTY in Stock",+RXH=2:"Drug Interaction",+RXH=3:"Patient Reaction",+RXH=4:"Physician to be Contacted",+RXH=5:"Allergy Reactions",+RXH=6:"Drug Reaction",1:"Other--See Comments")
- .S ^TMP("PSOR",$J,RX,"HOLD",0)=HDST_"^"_$P(RXH,"^",2)_"^"_$P(RXH,"^",3)
- S PSOCF=+$P(RX0,"^",17)*(+$P(RX0,"^",7)) ;cost of original fill;
- S ^TMP("PSOR",$J,RX,0)=PSOID_"^"_PSOFD_"^"_PSOLFD_"^"_$G(PSOX)_"^"_$P(RX0,"^")_"^"_$P(RX0,"^",7)_"^"_$P(RX0,"^",8)_"^"_$P(RX0,"^",9)_"^"_$G(PSORF)_"^"_+$P(RX0,"^",17)_"^"_$G(PSOCF)_"^"_$G(PSODT)_"^"_$P(RX2,"^",13)_"^"_$P(RX2,"^",15)
- S ^TMP("PSOR",$J,RX,0)=^TMP("PSOR",$J,RX,0)_"^"_$S($P($G(^PSRX(RX,"PC")),"^"):"Yes",1:"No")_"^"_$G(DFN)_";"_$P($G(^DPT(+$G(DFN),0)),"^")
- S ^TMP("PSOR",$J,RX,1)=PSOPR_"^"_CLK_"^"_VPR_"^"_CLN_"^"_RXP_"^"_MW_"^"_$P(RX2,"^",9)_"^"_$P(OERR,"^",2)
- S ^TMP("PSOR",$J,RX,"DRUG",0)=$G(PSODR)
- I +$G(^PSDRUG(+$P(RX0,"^",6),"ND")),+$P($G(^("ND")),"^",3) D
- .I $T(^PSNAPIS)]"" S PSOXN=$$PROD2^PSNAPIS($P(^PSDRUG(+$P(RX0,"^",6),"ND"),"^"),$P(^PSDRUG(+$P(RX0,"^",6),"ND"),"^",3)) S ^TMP("PSOR",$J,RX,"DRUG",0)=^TMP("PSOR",$J,RX,"DRUG",0)_"^"_$P($G(PSOXN),"^")_"^"_$P($G(PSOXN),"^",2) D Q
- ..S ^TMP("PSOR",$J,RX,"DRUG",0)=^TMP("PSOR",$J,RX,"DRUG",0)_"^"_$P(^PSDRUG(+$P(RX0,"^",6),0),"^",2) K PSOXN
- .S ^TMP("PSOR",$J,RX,"DRUG",0)=^TMP("PSOR",$J,RX,"DRUG",0)_"^"_$P($G(^PSNDF($P(^PSDRUG(+$P(RX0,"^",6),"ND"),"^"),5,+$P(^PSDRUG(+$P(RX0,"^",6),"ND"),"^",3),2)),"^")_"^"_$P($G(^(2)),"^",2)_"^"_$P(^PSDRUG(+$P(RX0,"^",6),0),"^",2)
- S ^TMP("PSOR",$J,RX,"DRUGOI",0)=$S(+$P(OERR,"^"):$P(OERR,"^")_";"_$P($G(^PS(50.7,+$P(OERR,"^"),0)),"^")_" "_$P($G(^PS(50.606,+$P($G(^(0)),"^",2),0)),"^"),1:"Not Matched to an Orderable Item")
- ;returns activity log
- F I=0:0 S I=$O(^PSRX(RX,"A",I)) Q:'I D
- .S ZR=$P(^PSRX(RX,"A",I,0),"^",2),RF=+$P(^(0),"^",4)
- .S RFT=$S(RF>0&(RF<6):"REFILL "_RF,RF=6:"PARTIAL",RF>6:"REFILL "_(RF-1),1:"ORIGINAL") D
- ..S REA=$S(ZR="H":"HOLD",ZR="U":"UNHOLD",ZR="C":"DISCONTINUED",ZR="E":"EDIT",ZR="L":"RENEWED",ZR="P":"PARTIAL",ZR="R":"REINSTATE",ZR="W":"REPRINT REQUEST",ZR="S":"SUSPENDED",ZR="I":"RETURNED TO STOCK",ZR="V":"INTERVENTION",1:0) I REA'=0 Q
- ..S REA=$S(ZR="D":"DELETED",ZR="A":"PENDING/DRUG INTERACTION",ZR="B":"PROCESSED",ZR="X":"X-INTERFACE",1:"EDIT")
- .S ^TMP("PSOR",$J,RX,"ACT",I,0)=$P(^PSRX(RX,"A",I,0),"^")_"^"_REA_"^"_$S($P(^(0),"^",3):$P(^(0),"^",3)_";"_$P($G(^VA(200,$P(^(0),"^",3),0)),"^"),1:"Unknown")_"^"_RFT_"^"_$P(^PSRX(RX,"A",I,0),"^",5) K REA,ZR,RFT,RF
- S SUS=$O(^PS(52.5,"B",RX,0)) I SUS D
- .S ^TMP("PSOR",$J,RX,"SUS",0)=$S(+$G(^PS(52.5,SUS,"P")):"Printed",1:"Not Printed")
- .I $P($G(^PS(52.5,SUS,0)),"^",7)]"" S CMIN=$P(^PS(52.5,SUS,0),"^",7) D
- ..S CMIND=$S(CMIN="Q":"Queued for Transmission",CMIN="X":"Transmission Completed",CMIN="L":"Loading Transmission",1:"Printed Locally"),^TMP("PSOR",$J,RX,"SUS",0)=^TMP("PSOR",$J,RX,"SUS",0)_"^"_CMIND
- I '$P($G(^PSRX(RX,"SIG")),"^",2) S ^TMP("PSOR",$J,RX,"SIG",1,0)=$P($G(^PSRX(RX,"SIG")),"^") D G CMOP
- .;expands and save SIG
- .S IEN=1,(SIG,X)=$P($G(^PSRX(RX,"SIG")),"^") D:'$G(PSUPSO) SIGONE^PSOHELP S SIG=$E($G(INS1),2,250)
- .F SG=1:1:$L(SIG) S:$L($G(^TMP("PSOR",$J,RX,"SIG1",IEN,0)))>75 IEN=IEN+1 S:$P(SIG," ",SG)'="" ^TMP("PSOR",$J,RX,"SIG1",IEN,0)=$G(^TMP("PSOR",$J,RX,"SIG1",IEN,0))_" "_$P(SIG," ",SG)
- E F I=0:0 S I=$O(^PSRX(RX,"SIG1",I)) Q:'I S ^TMP("PSOR",$J,RX,"SIG",I,0)=$G(^PSRX(RX,"SIG1",I,0)),^TMP("PSOR",$J,RX,"SIG1",I,0)=$G(^(0))
- CMOP F I=0:0 S I=$O(^PSRX(RX,4,I)) Q:'I I $D(^PSRX(RX,4,I,0)) S CMOP=^PSRX(RX,4,I,0) D
- .S ^TMP("PSOR",$J,RX,"CMOP",I,0)=$P(CMOP,"^")_"^"_$P(CMOP,"^",2)_"^"_$P(CMOP,"^",3)_"^"_$S($P(CMOP,"^",4)=1:"1;Dispensed",$P(CMOP,"^",4)=2:"2;Retransmitted",$P(CMOP,"^",4)=3:"3;Not Dispensed",1:"0;Transmitted")_"^"_$P(CMOP,"^",5)
- .S ^TMP("PSOR",$J,RX,"CMOP",I,0)=^TMP("PSOR",$J,RX,"CMOP",I,0)_"^"_$P(CMOP,"^",8)
- .S:$P(CMOP,"^",4)=3 ^TMP("PSOR",$J,RX,"CMOP",1,1,0)=$G(^PSRX(RX,4,I,1,0))
- K SIG,SG,IEN,CMOP,CMIN,CMIND,HDST,I,LSFD,PSO2,PSOCF,PSOCST,PSODR,PSODT,PSOLFD,PSOFD,PSOID,PSOJ,PSOPR,PSOPLCL,PSOPLPR,PSOREF,PSORF,PSORFCL,PSORFPR,PSOST,PSOX,RX,RX0,RX0,RX1,RX3,RX3,RXH,RXP,ST0,SUS
- Q
- ODT ;canceled or expiration date
- I +PSOST=12!(+PSOST=14)!(+PSOST=15) D
- .I $P(^PSRX(RX,3),"^",5) S PSODT=$P(^PSRX(RX,3),"^",5) Q
- .F PSOJ=0:0 S PSOJ=$O(^PSRX(RX,"A",PSOJ)) Q:PSOJ'>0 I $P($G(^PSRX(RX,"A",PSOJ,0)),"^")<PSODT,+$P($G(^(0)),"^",2)="C" S PSODT=+$P($G(^(0)),"^")
- Q
- PSOORDER ;BHAM ISC/SAB- utility routine to return Rx data ; 04/09/96 10:30 am
- +1 ;;7.0;OUTPATIENT PHARMACY;**11,20,9,46,103**;DEC 1997
- +2 ;External reference to File #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 ^SC supported by DBIA 10040
- +6 ;External reference to ^DPT supported by DBIA 10035
- +7 ;External reference to ^PSNAPIS supported by DBIA 2531
- +8 ;External reference to ^PSNDF supported by DBIA 2195
- +9 ;External reference to ^PS(50.7 supported by DBIA 2223
- +10 ;External reference to ^PS(50.606 supported by DBIA 2174
- +11 ;data returned
- +12 ;^tmp("psor",$j,rxn,0)=id^fd^lsfd^st^rx#^qty^ds^rf^rfm^drct^rxct^exdt^reldt^rtsdt^wpc^dfn
- +13 ;
- +14 ;if status equals Hold: ^tmp("psor",$j,rxn,"hold",0)=hdrs^hdcom^hddt
- +15 ;if the rx has an entry in the suspense file (#52.5) ^tmp("psor",$j,rxn,"sus",0)=prt^cmind
- +16 ;^tmp("psor",$j,rxn,1)= pr^clk^vrp^cln^rxp^mw^div^oerr#
- +17 ;
- +18 ;cmop data: If applicable
- +19 ;^tmp("psor",$j,rxn,"cmop",n,0)=trans #^seq #^fill #^cmsta^cmdc dt^ndc
- +20 ;^tmp("psor",$j,rx,"cmop",1,1,0)=cmdc reason
- +21 ;
- +22 ;^tmp("psor",$j,rxn,"drug",0)=dr^va print name^drug id^va drug class
- +23 ;^tmp("psor",$j,rxn,"drugoi",0)=orderable item
- +24 ;^tmp("psor",$j,rxn,"ib",0)=copay transaction type^ib number
- +25 ;^tmp("psor",$j,rxn,"ref",n,0)=rfd^pr^clk^qty^ds^drct^rxct^reldt^rstdt^m/w^div ;refill data
- +26 ;;^tmp("psor",$j,rxn,"act",n,0)=d/t^rea^new person^rx #^comments
- +27 ;^tmp("psor",$j,rxn,"rpar",n,0)=prd^pr^clk^qty^ds^drct^rxct^reldt^rstdt^m/w^div ;partial fill data
- +28 ;^tmp("psor",$j,rxn,"sig",n,0)=condensed medication instructions (SIG)
- +29 ;^tmp("psor",$j,rxn,"sig1",n,0)=expanded medication instructions (SIG)
- +30 ;^tmp("psor",$j,rxn,"act",n,0)=d/t^rea^new person^filltype^comments pso*7*20
- +31 ;
- +32 ;for full break down of data returned see DBIA #1878
- +33 ;
- EN(DFN,RX) ;
- +1 KILL ^TMP("PSOR",$JOB)
- +2 NEW SIG,SG,IEN,CMOP,CMIN,CMIND,HDST,I,LSFD,PSO2,PSOCF,PSOCST,PSODR,PSODT,PSOLFD,PSOFD,PSOID,PSOJ,PSOPR,PSOPLCL,PSOPLPR,PSOREF,PSORF,PSORFCL,PSORFPR,PSOST,PSOX,RX0,RX0,RX1,RX3,RX3,RXH,RXP,ST0,SUS
- +3 IF '$DATA(^PSRX(RX,0))!('$DATA(^PSRX(RX,2)))!('$DATA(^PSRX(RX,3)))!($GET(^PSRX(RX,"STA"))=13)
- QUIT
- +4 IF $GET(DFN)'=""
- IF $PIECE($GET(^PSRX(RX,0)),"^",2)'=$GET(DFN)
- QUIT
- +5 IF '$GET(DFN)
- SET DFN=+$PIECE($GET(^PSRX(RX,0)),"^",2)
- +6 KILL PSOLOUD
- IF $PIECE($GET(^PS(55,DFN,0)),"^",6)'=2
- DO EN^PSOHLUP(DFN)
- +7 IF $GET(^PSRX(RX,"IB"))]""
- SET ^TMP("PSOR",$JOB,RX,"IB")=$PIECE(^PSRX(RX,"IB"),"^",1,2)
- +8 SET RX0=^PSRX(RX,0)
- SET RX2=^(2)
- SET RX3=^(3)
- SET RXH=$GET(^("H"))
- SET PSORF=$PIECE(RX0,"^",9)
- SET LSFD=$PIECE(RX2,"^",2)
- SET ST0=$PIECE($GET(^("STA")),"^")
- SET OERR=$GET(^("OR1"))
- Begin DoDot:1
- +9 FOR I=0:0
- SET I=$ORDER(^PSRX(RX,1,I))
- IF 'I
- QUIT
- IF $DATA(^PSRX(RX,1,I,0))
- SET RX1(I)=^PSRX(RX,1,I,0)
- SET PSORF=PSORF-1
- SET LSFD=+RX1(I)
- SET PSOCST=$PIECE(RX1(I),"^",4)*+$PIECE(RX1(I),"^",11)
- Begin DoDot:2
- +10 SET PSORFPR=$PIECE(RX0,"^",4)
- IF PSORFPR
- SET PSORFPR=PSORFPR_";"_$PIECE($GET(^VA(200,PSORFPR,0)),"^")
- +11 SET PSORFCL=$PIECE(RX1(I),"^",7)
- IF PSORFCL
- SET PSORFCL=PSORFCL_";"_$PIECE($GET(^VA(200,PSORFCL,0)),"^")
- +12 SET ^TMP("PSOR",$JOB,RX,"REF",I,0)=+RX1(I)_"^"_$GET(PSORFPR)_"^"_$GET(PSORFCL)_"^"_$PIECE(RX1(I),"^",4)_"^"_+$PIECE(RX1(I),"^",10)_"^"_+$PIECE(RX1(I),"^",11)_"^"
- +13 SET ^TMP("PSOR",$JOB,RX,"REF",I,0)=^TMP("PSOR",$JOB,RX,"REF",I,0)_PSOCST_"^"_$PIECE(RX1(I),"^",18)_"^"_$PIECE(RX1(I),"^",16)_"^"_$SELECT($PIECE(RX1(I),"^",2)="M":"M;MAIL",1:"W;WINDOW")_"^"_$PIECE(RX1(I),"^",9)
- End DoDot:2
- +14 FOR I=0:0
- SET I=$ORDER(^PSRX(RX,"P",I))
- IF 'I
- QUIT
- IF $DATA(^PSRX(RX,"P",I,0))
- SET RXP(I)=^PSRX(RX,"P",I,0)
- Begin DoDot:2
- +15 SET PSOCST=$PIECE(RXP(I),"^",4)*+$PIECE(RXP(I),"^",11)
- +16 SET PSOPLPR=$PIECE(RX0,"^",4)
- IF PSOPLPR
- SET PSOPLPR=PSOPLPR_";"_$PIECE($GET(^VA(200,PSOPLPR,0)),"^")
- +17 SET PSOPLCL=$PIECE(RXP(I),"^",7)
- IF PSOPLCL
- SET PSOPLCL=PSOPLCL_";"_$PIECE($GET(^VA(200,PSOPLCL,0)),"^")
- +18 SET ^TMP("PSOR",$JOB,RX,"RPAR",I,0)=+RXP(I)_"^"_$GET(PSOPLPR)_"^"_$GET(PSOPLCL)_"^"_$PIECE(RXP(I),"^",4)_"^"_+$PIECE(RXP(I),"^",10)_"^"
- +19 SET ^TMP("PSOR",$JOB,RX,"RPAR",I,0)=^TMP("PSOR",$JOB,RX,"RPAR",I,0)_+$PIECE(RXP(I),"^",11)_"^"_PSOCST_"^"_$PIECE(RXP(I),"^",19)_"^"_$PIECE(RXP(I),"^",16)_"^"_$SELECT($PIECE(RXP(I),"^",2)="M":"M;MAIL",1:"W;WINDOW")_"^"_$PIECE(RXP
- (I),"^",9)
- End DoDot:2
- End DoDot:1
- +20 SET PSOLFD=+$GET(RX3)
- SET PSODR=+$PIECE(RX0,"^",6)
- SET PSOPR=$PIECE(RX0,"^",4)
- SET PSOREF=$PIECE(RX0,"^",9)
- SET PSOID=$PIECE(RX0,"^",13)
- SET PSOST=$PIECE($GET(^PSRX(RX,"STA")),"^")
- SET PSODT=$PIECE(RX2,"^",6)
- +21 DO ODT
- SET PSOFD=$PIECE(RX2,"^",2)
- SET PSOX=$SELECT($DATA(^PSDRUG(PSODR,0)):$PIECE(^(0),"^"),1:"NOT ON FILE")
- SET PSODR=PSODR_";"_PSOX
- +22 SET PSOPR=$PIECE(RX0,"^",4)
- IF PSOPR
- SET PSOX=$GET(^VA(200,PSOPR,0))
- SET PSOPR=PSOPR_";"_$PIECE(PSOX,"^")
- +23 SET CLK=$PIECE(RX0,"^",16)
- IF CLK
- SET PSOX=$GET(^VA(200,CLK,0))
- SET CLK=CLK_";"_$PIECE(PSOX,"^")
- +24 SET VPR=$PIECE(RX2,"^",10)
- IF VPR
- SET PSOX=$GET(^VA(200,VPR,0))
- SET VPR=VPR_";"_$PIECE(PSOX,"^")
- +25 SET CLN=$PIECE(RX0,"^",5)
- IF CLN
- SET PSOX=$GET(^SC(CLN,0))
- SET CLN=CLN_";"_$PIECE(PSOX,"^")
- +26 SET RXP=$PIECE(RX0,"^",3)_";"_$PIECE($GET(^PS(53,+$PIECE(RX0,"^",3),0)),"^")
- +27 SET MW=$SELECT($PIECE(RX0,"^",11)="W":"W;WINDOW",1:"M;MAIL")
- +28 SET PSOX="A;ACTIVE"
- IF $DATA(^PS(52.4,RX,0))
- SET PSOX="N;NON-VERIFIED"
- IF $ORDER(^PS(52.5,"B",RX,0))&($GET(^PS(52.5,+$ORDER(^PS(52.5,"B",RX,0)),"P"))'=1)
- SET PSOX="S;SUSPENDED"
- +29 IF ST0<12
- IF $PIECE(RX2,"^",6)<DT
- SET ST0=11
- +30 SET PSOX=$PIECE("Error^A;Active^N;Non-Verified^R;Refill^H;Hold^N;Non-Verified^S;Suspended^^^^^D;Done^E;Expired^DC;Discontinued^D;Deleted^DC;Discontinued^DC;Discontinued (Edit)^H;Provider Hold^","^",ST0+2)
- +31 IF PSOX="H;Hold"
- Begin DoDot:1
- +32 SET RXH=$GET(^PSRX(RX,"H"))
- +33 SET HDST=$SELECT(+RXH=1:"Insufficient QTY in Stock",+RXH=2:"Drug Interaction",+RXH=3:"Patient Reaction",+RXH=4:"Physician to be Contacted",+RXH=5:"Allergy Reactions",+RXH=6:"Drug Reaction",1:"Other--See Comments")
- +34 SET ^TMP("PSOR",$JOB,RX,"HOLD",0)=HDST_"^"_$PIECE(RXH,"^",2)_"^"_$PIECE(RXH,"^",3)
- End DoDot:1
- +35 ;cost of original fill;
- SET PSOCF=+$PIECE(RX0,"^",17)*(+$PIECE(RX0,"^",7))
- +36 SET ^TMP("PSOR",$JOB,RX,0)=PSOID_"^"_PSOFD_"^"_PSOLFD_"^"_$GET(PSOX)_"^"_$PIECE(RX0,"^")_"^"_$PIECE(RX0,"^",7)_"^"_$PIECE(RX0,"^",8)_"^"_...
- ... $PIECE(RX0,"^",9)_"^"_$GET(PSORF)_"^"_+$PIECE(RX0,"^",17)_"^"_$GET(PSOCF)_"^"_$GET(PSODT)_"^"_$PIECE(RX2,"^",13)_"^"_$PIECE(RX2,"^",15)
- +37 SET ^TMP("PSOR",$JOB,RX,0)=^TMP("PSOR",$JOB,RX,0)_"^"_$SELECT($PIECE($GET(^PSRX(RX,"PC")),"^"):"Yes",1:"No")_"^"_$GET(DFN)_";"_$PIECE($GET(^DPT(+$GET(DFN),0)),"^")
- +38 SET ^TMP("PSOR",$JOB,RX,1)=PSOPR_"^"_CLK_"^"_VPR_"^"_CLN_"^"_RXP_"^"_MW_"^"_$PIECE(RX2,"^",9)_"^"_$PIECE(OERR,"^",2)
- +39 SET ^TMP("PSOR",$JOB,RX,"DRUG",0)=$GET(PSODR)
- +40 IF +$GET(^PSDRUG(+$PIECE(RX0,"^",6),"ND"))
- IF +$PIECE($GET(^("ND")),"^",3)
- Begin DoDot:1
- +41 IF $TEXT(^PSNAPIS)]""
- SET PSOXN=$$PROD2^PSNAPIS($PIECE(^PSDRUG(+$PIECE(RX0,"^",6),"ND"),"^"),$PIECE(^PSDRUG(+$PIECE(RX0,"^",6),"ND"),"^",3))
- SET ^TMP("PSOR",$JOB,RX,"DRUG",0)=^TMP("PSOR",$JOB,RX,"DRUG",0)_"^"_$PIECE($GET(PSOXN),"^")_"^"_$PIECE($GET(PSOXN),"^",2)
- Begin DoDot:2
- +42 SET ^TMP("PSOR",$JOB,RX,"DRUG",0)=^TMP("PSOR",$JOB,RX,"DRUG",0)_"^"_$PIECE(^PSDRUG(+$PIECE(RX0,"^",6),0),"^",2)
- KILL PSOXN
- End DoDot:2
- QUIT
- +43 SET ^TMP("PSOR",$JOB,RX,"DRUG",0)=^TMP("PSOR",$JOB,RX,"DRUG",0)_"^"_$PIECE($GET(^PSNDF($PIECE(^PSDRUG(+$PIECE(RX0,"^",6),"ND"),"^"),5,+$PIECE(^PSDRUG(+$PIECE(RX0,"^",6),"ND"),"^",3),2)),"^")_"^"_...
- ... $PIECE($GET(^(2)),"^",2)_"^"_$PIECE(^PSDRUG(+$PIECE(RX0,"^",6),0),"^",2)
- End DoDot:1
- +44 SET ^TMP("PSOR",$JOB,RX,"DRUGOI",0)=$SELECT(+$PIECE(OERR,"^"):$PIECE(OERR,"^")_";"_$PIECE($GET(^PS(50.7,+$PIECE(OERR,"^"),0)),"^")_" "_$PIECE($GET(^PS(50.606,+$PIECE($GET(^(0)),"^",2),0)),"^"),1:"Not Matched to an Orderable Item")
- +45 ;returns activity log
- +46 FOR I=0:0
- SET I=$ORDER(^PSRX(RX,"A",I))
- IF 'I
- QUIT
- Begin DoDot:1
- +47 SET ZR=$PIECE(^PSRX(RX,"A",I,0),"^",2)
- SET RF=+$PIECE(^(0),"^",4)
- +48 SET RFT=$SELECT(RF>0&(RF<6):"REFILL "_RF,RF=6:"PARTIAL",RF>6:"REFILL "_(RF-1),1:"ORIGINAL")
- Begin DoDot:2
- +49 SET REA=$SELECT(ZR="H":"HOLD",ZR="U":"UNHOLD",ZR="C":"DISCONTINUED",ZR="E":"EDIT",ZR="L":"RENEWED",ZR="P":"PARTIAL",ZR="R":"REINSTATE",ZR="W":"REPRINT REQUEST",ZR="S":"SUSPENDED",ZR="I":"RETURNED TO STOCK",ZR="V":"INTERVENTION",1:0)
- IF REA'=0
- QUIT
- +50 SET REA=$SELECT(ZR="D":"DELETED",ZR="A":"PENDING/DRUG INTERACTION",ZR="B":"PROCESSED",ZR="X":"X-INTERFACE",1:"EDIT")
- End DoDot:2
- +51 SET ^TMP("PSOR",$JOB,RX,"ACT",I,0)=$PIECE(^PSRX(RX,"A",I,0),"^")_"^"_REA_"^"_$SELECT($PIECE(^(0),"^",3):$PIECE(^(0),"^",3)_";"_$PIECE($GET(^VA(200,$PIECE(^(0),"^",3),0)),"^"),1:"Unknown")_"^"_RFT_"^"_$PIECE(^PSRX(RX,"A",I,0),"^",5)
- KILL REA,ZR,RFT,RF
- End DoDot:1
- +52 SET SUS=$ORDER(^PS(52.5,"B",RX,0))
- IF SUS
- Begin DoDot:1
- +53 SET ^TMP("PSOR",$JOB,RX,"SUS",0)=$SELECT(+$GET(^PS(52.5,SUS,"P")):"Printed",1:"Not Printed")
- +54 IF $PIECE($GET(^PS(52.5,SUS,0)),"^",7)]""
- SET CMIN=$PIECE(^PS(52.5,SUS,0),"^",7)
- Begin DoDot:2
- +55 SET CMIND=$SELECT(CMIN="Q":"Queued for Transmission",CMIN="X":"Transmission Completed",CMIN="L":"Loading Transmission",1:"Printed Locally")
- SET ^TMP("PSOR",$JOB,RX,"SUS",0)=^TMP("PSOR",$JOB,RX,"SUS",0)_"^"_CMIND
- End DoDot:2
- End DoDot:1
- +56 IF '$PIECE($GET(^PSRX(RX,"SIG")),"^",2)
- SET ^TMP("PSOR",$JOB,RX,"SIG",1,0)=$PIECE($GET(^PSRX(RX,"SIG")),"^")
- Begin DoDot:1
- +57 ;expands and save SIG
- +58 SET IEN=1
- SET (SIG,X)=$PIECE($GET(^PSRX(RX,"SIG")),"^")
- IF '$GET(PSUPSO)
- DO SIGONE^PSOHELP
- SET SIG=$EXTRACT($GET(INS1),2,250)
- +59 FOR SG=1:1:$LENGTH(SIG)
- IF $LENGTH($GET(^TMP("PSOR",$JOB,RX,"SIG1",IEN,0)))>75
- SET IEN=IEN+1
- IF $PIECE(SIG," ",SG)'=""
- SET ^TMP("PSOR",$JOB,RX,"SIG1",IEN,0)=$GET(^TMP("PSOR",$JOB,RX,"SIG1",IEN,0))_" "_$PIECE(SIG," ",SG)
- End DoDot:1
- GOTO CMOP
- +60 IF '$TEST
- FOR I=0:0
- SET I=$ORDER(^PSRX(RX,"SIG1",I))
- IF 'I
- QUIT
- SET ^TMP("PSOR",$JOB,RX,"SIG",I,0)=$GET(^PSRX(RX,"SIG1",I,0))
- SET ^TMP("PSOR",$JOB,RX,"SIG1",I,0)=$GET(^(0))
- CMOP FOR I=0:0
- SET I=$ORDER(^PSRX(RX,4,I))
- IF 'I
- QUIT
- IF $DATA(^PSRX(RX,4,I,0))
- SET CMOP=^PSRX(RX,4,I,0)
- Begin DoDot:1
- +1 SET ^TMP("PSOR",$JOB,RX,"CMOP",I,0)=$PIECE(CMOP,"^")_"^"_$PIECE(CMOP,"^",2)_"^"_$PIECE(CMOP,"^",3)_"^"_$SELECT($PIECE(CMOP,"^",4)=1:"1;Dispensed",...
- ... $PIECE(CMOP,"^",4)=2:"2;Retransmitted",$PIECE(CMOP,"^",4)=3:"3;Not Dispensed",1:"0;Transmitted")_"^"_$PIECE(CMOP,"^",5)
- +2 SET ^TMP("PSOR",$JOB,RX,"CMOP",I,0)=^TMP("PSOR",$JOB,RX,"CMOP",I,0)_"^"_$PIECE(CMOP,"^",8)
- +3 IF $PIECE(CMOP,"^",4)=3
- SET ^TMP("PSOR",$JOB,RX,"CMOP",1,1,0)=$GET(^PSRX(RX,4,I,1,0))
- End DoDot:1
- +4 KILL SIG,SG,IEN,CMOP,CMIN,CMIND,HDST,I,LSFD,PSO2,PSOCF,PSOCST,PSODR,PSODT,PSOLFD,PSOFD,PSOID,PSOJ,PSOPR,PSOPLCL,PSOPLPR,PSOREF,PSORF,PSORFCL,PSORFPR,PSOST,PSOX,RX,RX0,RX0,RX1,RX3,RX3,RXH,RXP,ST0,SUS
- +5 QUIT
- ODT ;canceled or expiration date
- +1 IF +PSOST=12!(+PSOST=14)!(+PSOST=15)
- Begin DoDot:1
- +2 IF $PIECE(^PSRX(RX,3),"^",5)
- SET PSODT=$PIECE(^PSRX(RX,3),"^",5)
- QUIT
- +3 FOR PSOJ=0:0
- SET PSOJ=$ORDER(^PSRX(RX,"A",PSOJ))
- IF PSOJ'>0
- QUIT
- IF $PIECE($GET(^PSRX(RX,"A",PSOJ,0)),"^")<PSODT
- IF +$PIECE($GET(^(0)),"^",2)="C"
- SET PSODT=+$PIECE($GET(^(0)),"^")
- End DoDot:1
- +4 QUIT
