BGORX ; IHS/BAO/TMD - Pharmacy Utilities ;
;;1.1;BGO;**1**;JUN 02, 2005
;
;
ALLOPRX(BGORET,BGOP) ;BGORET is array value, all op meds
; input data - dfn|rx age
N S,DT1,DT2,DFN,C,%DT,Y,X,Z,T,RX,CHR,DUP,DRUG,CNT,UNDUP
K ^TMP("BGOALLRX",$J)
S C=0
I $G(BGOP)="" S BGORET="-1^Missing Input Data" Q
S S="OR_RXOP:ALL OUTPATIENT~RXOP;ORDV06;28;10"
S DFN=+BGOP Q:'DFN
S DT1=$P(BGOP,"|",2)
S DUP=$P(BGOP,"|",3)
S DRUG=$P(BGOP,"|",4)
I DT1="" S DT1="T-30"
S %DT="T",X=DT1 D ^%DT Q:'Y S DT1=Y
S %DT="T",X="T" D ^%DT Q:'Y S DT2=Y
D RPT^ORWRP(.BGORET,DFN,S,"","","",DT1,DT2)
Q:$E(BGORET,1,4)'="^TMP"
S N=$P($P(BGORET,",",2),")",1) Q:'N
S X=0 F S X=$O(^TMP("ORDATA",N,X)) Q:'X D
.I DRUG Q:$P(^TMP("ORDATA",N,X,"WP",3),U,2)'=DRUG
.I 'DUP,$P($G(UNDUP($P(^TMP("ORDATA",N,X,"WP",3),U,2))),U)>$P(^TMP("ORDATA",N,X,"WP",8),U,2) Q
.S Y=0 F S Y=$O(^TMP("ORDATA",N,X,"WP",Y)) Q:'Y D
..I Y=1 S S=$P($P(^TMP("ORDATA",N,X,"WP",Y),U,2),";",1)
..I Y'=14 S $P(S,U,Y)=$P(^TMP("ORDATA",N,X,"WP",Y),U,2)
..I Y=14 S T="" D S $P(S,U,Y)=T
...S Z=0 F S Z=$O(^TMP("ORDATA",N,X,"WP",Y,Z)) Q:'Z D
....S T=T_$P(^TMP("ORDATA",N,X,"WP",Y,Z),U,2)
.S RX=$P(S,U,4) Q:RX=""
.S RX=$O(^PSRX("B",RX,0)),CHR=$P($G(^PSRX(+RX,9999999)),U,2)
.S $P(S,U,15)=CHR
.I DUP S CNT=C,C=C+1
.I 'DUP D
..I $D(UNDUP($P(^TMP("ORDATA",N,X,"WP",3),U,2))) S CNT=$P(^(3),U,2)
..E S CNT=C,C=C+1
..S UNDUP($P(^TMP("ORDATA",N,X,"WP",3),U,2))=$P(^TMP("ORDATA",N,X,"WP",8),U,2)_U_CNT
.S ^TMP("BGOALLRX",$J,CNT)=S_$C(13)_$C(10)
S BGORET="^TMP("_"""BGOALLRX"""_","_$J_")"
Q
;
RXCHR(BGORET,BGOP) ;
; input data - RX|Y/N
N DA,DIE,DR,CHR
S DA=+BGOP,CHR=$P(BGOP,"|",2)
S DA=$O(^PSRX("B",DA,0)) Q:'DA
S DIE="^PSRX(",DR="9999999.02///"_CHR D ^DIE
S BGORET=$S('$D(Y):0,1:-1)
Q
;
RXRPT(DATA,BGOI) ;DATA is return value,
; BGOI input data = rpc/parameters
;
S PSOVDA=+BGOI Q:'PSOVDA
S PS="VIEW"
S DATA="^TMP("_"""PSOAL"""_","_$J_")"
K ^TMP("PSOAL",$J),PCOMX,PDA,PHI,PRC,ACOM,ANS
S (DA,RXN)=PSOVDA K PSOVDA S RX0=^PSRX(RXN,0),PSODFN=+$P(^(0),U,2),RX2=$G(^(2)),RX3=$G(^(3)),ST=+$G(^("STA")),RXOR=$G(^("OR1"))
I 'RXOR,$P(^PSDRUG($P(RX0,"^",6),2),"^") S $P(^PSRX(RXN,"OR1"),"^")=$P(^PSDRUG($P(RX0,"^",6),2),"^"),RXOR=$P(^PSDRUG($P(RX0,"^",6),2),"^")
S IEN=0,$P(RN," ",12)=" "
S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=$S($P($G(^PSRX(RXN,"TPB")),"^"):" TPB Rx #: ",1:" Rx #: ")_$P(RX0,"^")_$S($G(^PSRX(RXN,"IB")):"$",1:"")_$E(RN,$L($P(RX0,"^")_$S($G(^PSRX(RXN,"IB")):"$",1:""))+1,12)
S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" Orderable Item: "_$S($D(^PS(50.7,$P(+RXOR,"^"),0)):$P(^PS(50.7,$P(+RXOR,"^"),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^"),1:"No Pharmacy Orderable Item")
S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=$S($D(^PSDRUG("AQ",$P(RX0,"^",6))):" CMOP ",1:" ")_"Drug: "_$P(^PSDRUG($P(RX0,"^",6),0),"^")
S:$G(^PSRX(RXN,"TN"))]"" IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" Trade Name: "_$G(^PSRX(RXN,"TN"))
D IHSFLDS ; IHS/CIA/PLS - 01/08/04 - Build IHS output
D DOSE^PSORXVW1
S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Patient Instructions:" I $O(^PSRX(RXN,"INS1",0)) D
.F I=0:0 S I=$O(^PSRX(RXN,"INS1",I)) Q:'I S MIG=$P(^PSRX(RXN,"INS1",I,0),"^") D
..F SG=1:1:$L(MIG) S:$L(^TMP("PSOAL",$J,IEN,0)_" "_$P(MIG," ",SG))>80 IEN=IEN+1,$P(^TMP("PSOAL",$J,IEN,0)," ",21)=" " S:$P(MIG," ",SG)'="" ^TMP("PSOAL",$J,IEN,0)=$G(^TMP("PSOAL",$J,IEN,0))_" "_$P(MIG," ",SG)
K MIG,SG
I $P($G(^PS(55,PSODFN,"LAN")),"^") S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" Other Pat. Instruc: "_$S($G(^PSRX(RXN,"INSS"))]"":^PSRX(RXN,"INSS"),1:"")
S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" SIG:"
I '$P($G(^PSRX(RXN,"SIG")),"^",2) D G PTST
.S X=$P($G(^PSRX(RXN,"SIG")),"^") D SIGONE^PSOHELP S SIG=$E($G(INS1),2,250)
.F SG=1:1:$L(SIG) S:$L(^TMP("PSOAL",$J,IEN,0)_" "_$P(SIG," ",SG))>80 IEN=IEN+1,$P(^TMP("PSOAL",$J,IEN,0)," ",21)=" " S:$P(SIG," ",SG)'="" ^TMP("PSOAL",$J,IEN,0)=$G(^TMP("PSOAL",$J,IEN,0))_" "_$P(SIG," ",SG)
S SIGOK=1
F I=0:0 S I=$O(^PSRX(RXN,"SIG1",I)) Q:'I S MIG=$P(^PSRX(RXN,"SIG1",I,0),"^") D
.F SG=1:1:$L(MIG) S:$L(^TMP("PSOAL",$J,IEN,0)_" "_$P(MIG," ",SG))>80 IEN=IEN+1,$P(^TMP("PSOAL",$J,IEN,0)," ",21)=" " S:$P(MIG," ",SG)'="" ^TMP("PSOAL",$J,IEN,0)=$G(^TMP("PSOAL",$J,IEN,0))_" "_$P(MIG," ",SG)
S SIGOK=1 K MIG,SG
PTST S $P(RN," ",25)=" ",PTST=$S($G(^PS(53,+$P(RX0,"^",3),0))]"":$P($G(^PS(53,+$P(RX0,"^",3),0)),"^"),1:""),IEN=IEN+1
S ^TMP("PSOAL",$J,IEN,0)=" Patient Status: "_PTST_$E(RN,$L(PTST)+1,25)
S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" Issue Date: "_$E($P(RX0,"^",13),4,5)_"/"_$E($P(RX0,"^",13),6,7)_"/"_$E($P(RX0,"^",13),2,3)
S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_" Fill Date: "_$E($P(RX2,"^",2),4,5)_"/"_$E($P(RX2,"^",2),6,7)_"/"_$E($P(RX2,"^",2),2,3)
S ROU=$S($P(RX0,"^",11)="W":"Window",1:"Mail")
S REFL=$P(RX0,"^",9),I=0 F S I=$O(^PSRX(RXN,1,I)) Q:'I S REFL=REFL-1,ROU=$S($P(^PSRX(RXN,1,I,0),"^",2)="W":"Window",1:"Mail")
S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" Last Fill Date: "_$E($P(RX3,"^"),4,5)_"/"_$E($P(RX3,"^"),6,7)_"/"_$E($P(RX3,"^"),2,3)
;D CMOP^PSOORNE3 S DA=RXN
S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_" ("_ROU_$S($G(PSOCMOP)]"":", "_PSOCMOP,1:"")_")" K ROU,PSOCMOP
S IEN=IEN+1 I $P(RX2,"^",15) S ^TMP("PSOAL",$J,IEN,0)=" Returned to Stock: "_$E($P(RX2,"^",15),4,5)_"/"_$E($P(RX2,"^",15),6,7)_"/"_$E($P(RX2,"^",15),2,3)
E S ^TMP("PSOAL",$J,IEN,0)=" Last Release Date: " D
.S RLD=$S($P(RX2,"^",13):$E($P(RX2,"^",13),4,5)_"/"_$E($P(RX2,"^",13),6,7)_"/"_$E($P(RX2,"^",13),2,3),1:"")
.I $O(^PSRX(RXN,1,0)) F I=0:0 S I=$O(^PSRX(RXN,1,I)) Q:'I D
..I $P(^PSRX(RXN,1,I,0),"^",18) S RLD=$E($P(^(0),"^",18),4,5)_"/"_$E($P(^(0),"^",18),6,7)_"/"_$E($P(^(0),"^",18),2,3)
.S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_RLD
S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" Expires: "_$E($P(RX2,"^",6),4,5)_"/"_$E($P(RX2,"^",6),6,7)_"/"_$E($P(RX2,"^",6),2,3)
S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_" Lot #: "_$S($P(RX2,"^",4):$P(RX2,"^",4),1:"")
S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" Days Supply: "_$P(RX0,"^",8)_$S($L($P(RX0,"^",8))=1:" ",1:"")
S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_" QTY"_$S($P($G(^PSDRUG($P(RX0,"^",6),660)),"^",8)]"":" ("_$P($G(^PSDRUG($P(RX0,"^",6),660)),"^",8)_")",1:" ( )")_": "_$P(RX0,"^",7)
I $P($G(^PSDRUG($P(RX0,"^",6),5)),"^")]"" D
.S $P(RN," ",79)=" ",IEN=IEN+1
.S ^TMP("PSOAL",$J,IEN,0)=$E(RN,$L("QTY DSP MSG: "_$P(^PSDRUG($P(RX0,"^",6),5),"^"))+1,79)_"QTY DSP MSG: "_$P(^PSDRUG($P(RX0,"^",6),5),"^") K RN
S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" # of Refills: "_$P(RX0,"^",9)_$S($L($P(RX0,"^",9))=1:" ",1:"")_" Remaining: "_REFL
S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" Provider: "_$S($D(^VA(200,$P(RX0,"^",4),0)):$P(^VA(200,$P(RX0,"^",4),0),"^"),1:"UNKNOWN")
I $P(RX3,"^",3) S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" Cos-Provider: "_$P(^VA(200,$P(RX3,"^",3),0),"^")
S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" Routing: "_$S($P(RX0,"^",11)="W":"Window",1:"Mail")
S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" Copies: "_$S($P(RX0,"^",18):$P(RX0,"^",18),1:1)
S:$P(RX0,"^",11)="W" IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" Method of Pickup: "_$G(^PSRX(RXN,"MP"))
S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" Clinic: "_$S($D(^SC(+$P(RX0,"^",5),0)):$P(^SC($P(RX0,"^",5),0),"^"),1:"Not on File")
S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" Division: "_$P(^PS(59,$P(RX2,"^",9),0),"^")_" ("_$P(^(0),"^",6)_")"
S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" Pharmacist: "_$S($P(RX2,"^",3):$P(^VA(200,$P(RX2,"^",3),0),"^"),1:"")
S:$P(RX2,"^",10)&('$G(PSOCOPY)) IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" Verified By: "_$P(^VA(200,$P(RX2,"^",10),0),"^")
; IHS/CIA/PLS - 01/25/04 - Removed from display
;S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" Patient Counseling: "_$S($P($G(^PSRX(RXN,"PC")),"^"):"YES",1:"NO")_" "_$S($P($G(^PSRX(RXN,"PC")),"^"):"Was Counseling Understood: "_$S($P($G(^PSRX(RXN,"PC")),"^",2):"YES",1:"NO"),1:"")
S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" Remarks: "_$P(RX3,"^",7)
D PC^PSORXVW1
I $P($G(^PSRX(DA,"OR1")),"^",5) S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" Finished By: "_$P(^VA(200,$P(^PSRX(DA,"OR1"),"^",5),0),"^")
S $P(RN," ",35)=" ",IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" Entry By: "_$P($G(^VA(200,+$P(RX0,"^",16),0)),"^")_$E(RN,$L($P($G(^VA(200,+$P(RX0,"^",16),0)),"^"))+1,35)
S Y=$P(RX2,"^") X ^DD("DD")
S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_"Entry Date: "_$E($P(RX2,"^"),4,5)_"/"_$E($P(RX2,"^"),6,7)_"/"_$E($P(RX2,"^"),2,3)_" "_$P(Y,"@",2) K RN
D ^PSORXVW1 S PSOAL=IEN K IEN,ACT,LBL,LOG
I ST<12,$P(RX2,"^",6)<DT S ST=11
S ^TMP("PSOAL",$J,1,0)=^TMP("PSOAL",$J,1,0)_" ("_$P("Error^Active^Non-Verified^Refill^Hold^Non-Verified^Suspended^^^^^Done^Expired^Discontinued^Deleted^Discontinued^Discontinued (Edit)^Provider Hold^","^",ST+2)_")"
S:$P($G(^PSRX(DA,"PKI")),"^") ^TMP("PSOAL",$J,1,0)=^TMP("PSOAL",$J,1,0)_" Digitally Signed Order"
;D EN^PSOORAL,KILL G:PS="VIEW" PSORXVW
D KILL
Q
KILL K PS,DA
K ^TMP("PSOHDR",$J)
K ST,RFL,RFLL,RFL1,ST,II,J,N,PHYS,L1,DIRUT,PSDIV,PSEXDT,MED,M1,FFX,DTT,DAT,RX0,RX2,R3,RTN,SIG,STA,P1,PL,P0,Z0,Z1,EXDT,IFN,DIR,DUOUT,DTOUT,PSOELSE
K LBL,I,RFDATE,%H,%I,RN,RFT,%,%I,DFN,GMRAL,HDR,POERR,PTST,REFL,RF,RLD,RX3
K RXN,RXOR,SG,VA,VADM,VAERR,VALMBCK,VAPA,X,DIC,REA,ZD,PSOHD,PSOBCK,PSODFN,INS1,PSOAL,PSOCOPY,SIGOK
Q
; IHS/CIA/PLS - 01/08/04 - Build IHS data
IHSFLDS ; EP
S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" NDC: "_$P(RX2,U,7)
S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_" AWP: "_$$GET1^DIQ(52,RXN,9999999.06)_" UP: "_$$GET1^DIQ(52,RXN,17)
S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" TRIPLICATE #: "_$$GET1^DIQ(52,RXN,9999999.14)
Q
BGORX ; IHS/BAO/TMD - Pharmacy Utilities ;
+1 ;;1.1;BGO;**1**;JUN 02, 2005
+2 ;
+3 ;
ALLOPRX(BGORET,BGOP) ;BGORET is array value, all op meds
+1 ; input data - dfn|rx age
+2 NEW S,DT1,DT2,DFN,C,%DT,Y,X,Z,T,RX,CHR,DUP,DRUG,CNT,UNDUP
+3 KILL ^TMP("BGOALLRX",$JOB)
+4 SET C=0
+5 IF $GET(BGOP)=""
SET BGORET="-1^Missing Input Data"
QUIT
+6 SET S="OR_RXOP:ALL OUTPATIENT~RXOP;ORDV06;28;10"
+7 SET DFN=+BGOP
IF 'DFN
QUIT
+8 SET DT1=$PIECE(BGOP,"|",2)
+9 SET DUP=$PIECE(BGOP,"|",3)
+10 SET DRUG=$PIECE(BGOP,"|",4)
+11 IF DT1=""
SET DT1="T-30"
+12 SET %DT="T"
SET X=DT1
DO ^%DT
IF 'Y
QUIT
SET DT1=Y
+13 SET %DT="T"
SET X="T"
DO ^%DT
IF 'Y
QUIT
SET DT2=Y
+14 DO RPT^ORWRP(.BGORET,DFN,S,"","","",DT1,DT2)
+15 IF $EXTRACT(BGORET,1,4)'="^TMP"
QUIT
+16 SET N=$PIECE($PIECE(BGORET,",",2),")",1)
IF 'N
QUIT
+17 SET X=0
FOR
SET X=$ORDER(^TMP("ORDATA",N,X))
IF 'X
QUIT
Begin DoDot:1
+18 IF DRUG
IF $PIECE(^TMP("ORDATA",N,X,"WP",3),U,2)'=DRUG
QUIT
+19 IF 'DUP
IF $PIECE($GET(UNDUP($PIECE(^TMP("ORDATA",N,X,"WP",3),U,2))),U)>$PIECE(^TMP("ORDATA",N,X,"WP",8),U,2)
QUIT
+20 SET Y=0
FOR
SET Y=$ORDER(^TMP("ORDATA",N,X,"WP",Y))
IF 'Y
QUIT
Begin DoDot:2
+21 IF Y=1
SET S=$PIECE($PIECE(^TMP("ORDATA",N,X,"WP",Y),U,2),";",1)
+22 IF Y'=14
SET $PIECE(S,U,Y)=$PIECE(^TMP("ORDATA",N,X,"WP",Y),U,2)
+23 IF Y=14
SET T=""
Begin DoDot:3
+24 SET Z=0
FOR
SET Z=$ORDER(^TMP("ORDATA",N,X,"WP",Y,Z))
IF 'Z
QUIT
Begin DoDot:4
+25 SET T=T_$PIECE(^TMP("ORDATA",N,X,"WP",Y,Z),U,2)
End DoDot:4
End DoDot:3
SET $PIECE(S,U,Y)=T
End DoDot:2
+26 SET RX=$PIECE(S,U,4)
IF RX=""
QUIT
+27 SET RX=$ORDER(^PSRX("B",RX,0))
SET CHR=$PIECE($GET(^PSRX(+RX,9999999)),U,2)
+28 SET $PIECE(S,U,15)=CHR
+29 IF DUP
SET CNT=C
SET C=C+1
+30 IF 'DUP
Begin DoDot:2
+31 IF $DATA(UNDUP($PIECE(^TMP("ORDATA",N,X,"WP",3),U,2)))
SET CNT=$PIECE(^(3),U,2)
+32 IF '$TEST
SET CNT=C
SET C=C+1
+33 SET UNDUP($PIECE(^TMP("ORDATA",N,X,"WP",3),U,2))=$PIECE(^TMP("ORDATA",N,X,"WP",8),U,2)_U_CNT
End DoDot:2
+34 SET ^TMP("BGOALLRX",$JOB,CNT)=S_$CHAR(13)_$CHAR(10)
End DoDot:1
+35 SET BGORET="^TMP("_"""BGOALLRX"""_","_$JOB_")"
+36 QUIT
+37 ;
RXCHR(BGORET,BGOP) ;
+1 ; input data - RX|Y/N
+2 NEW DA,DIE,DR,CHR
+3 SET DA=+BGOP
SET CHR=$PIECE(BGOP,"|",2)
+4 SET DA=$ORDER(^PSRX("B",DA,0))
IF 'DA
QUIT
+5 SET DIE="^PSRX("
SET DR="9999999.02///"_CHR
DO ^DIE
+6 SET BGORET=$SELECT('$DATA(Y):0,1:-1)
+7 QUIT
+8 ;
RXRPT(DATA,BGOI) ;DATA is return value,
+1 ; BGOI input data = rpc/parameters
+2 ;
+3 SET PSOVDA=+BGOI
IF 'PSOVDA
QUIT
+4 SET PS="VIEW"
+5 SET DATA="^TMP("_"""PSOAL"""_","_$JOB_")"
+6 KILL ^TMP("PSOAL",$JOB),PCOMX,PDA,PHI,PRC,ACOM,ANS
+7 SET (DA,RXN)=PSOVDA
KILL PSOVDA
SET RX0=^PSRX(RXN,0)
SET PSODFN=+$PIECE(^(0),U,2)
SET RX2=$GET(^(2))
SET RX3=$GET(^(3))
SET ST=+$GET(^("STA"))
SET RXOR=$GET(^("OR1"))
+8 IF 'RXOR
IF $PIECE(^PSDRUG($PIECE(RX0,"^",6),2),"^")
SET $PIECE(^PSRX(RXN,"OR1"),"^")=$PIECE(^PSDRUG($PIECE(RX0,"^",6),2),"^")
SET RXOR=$PIECE(^PSDRUG($PIECE(RX0,"^",6),2),"^")
+9 SET IEN=0
SET $PIECE(RN," ",12)=" "
+10 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=$SELECT($PIECE($GET(^PSRX(RXN,"TPB")),"^"):" TPB Rx #: ",1:" Rx #: ")_$PIECE(RX0,"^")_$SELECT($GET(^PSRX(RXN,"IB")):"$",1:"")_$EXTRACT(RN,$LENGTH(...
... $PIECE(RX0,"^")_$SELECT($GET(^PSRX(RXN,"IB")):"$",1:""))+1,12)
+11 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" Orderable Item: "_$SELECT($DATA(^PS(50.7,$PIECE(+RXOR,"^"),0)):$PIECE(^PS(50.7,$PIECE(+RXOR,"^"),0),"^")_" "_$PIECE(^PS(50.606,$PIECE(^(0),"^",2),0),"^"),1:"No Pharmacy Orderable Item")
+12 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=$SELECT($DATA(^PSDRUG("AQ",$PIECE(RX0,"^",6))):" CMOP ",1:" ")_"Drug: "_$PIECE(^PSDRUG($PIECE(RX0,"^",6),0),"^")
+13 IF $GET(^PSRX(RXN,"TN"))]""
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" Trade Name: "_$GET(^PSRX(RXN,"TN"))
+14 ; IHS/CIA/PLS - 01/08/04 - Build IHS output
DO IHSFLDS
+15 DO DOSE^PSORXVW1
+16 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)="Patient Instructions:"
IF $ORDER(^PSRX(RXN,"INS1",0))
Begin DoDot:1
+17 FOR I=0:0
SET I=$ORDER(^PSRX(RXN,"INS1",I))
IF 'I
QUIT
SET MIG=$PIECE(^PSRX(RXN,"INS1",I,0),"^")
Begin DoDot:2
+18 FOR SG=1:1:$LENGTH(MIG)
IF $LENGTH(^TMP("PSOAL",$JOB,IEN,0)_" "_$PIECE(MIG," ",SG))>80
SET IEN=IEN+1
SET $PIECE(^TMP("PSOAL",$JOB,IEN,0)," ",21)=" "
IF $PIECE(MIG," ",SG)'=""
SET ^TMP("PSOAL",$JOB,IEN,0)=$GET(^TMP("PSOAL",$JOB,IEN,0))_" "_$PIECE(MIG," ",SG)
End DoDot:2
End DoDot:1
+19 KILL MIG,SG
+20 IF $PIECE($GET(^PS(55,PSODFN,"LAN")),"^")
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" Other Pat. Instruc: "_$SELECT($GET(^PSRX(RXN,"INSS"))]"":^PSRX(RXN,"INSS"),1:"")
+21 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" SIG:"
+22 IF '$PIECE($GET(^PSRX(RXN,"SIG")),"^",2)
Begin DoDot:1
+23 SET X=$PIECE($GET(^PSRX(RXN,"SIG")),"^")
DO SIGONE^PSOHELP
SET SIG=$EXTRACT($GET(INS1),2,250)
+24 FOR SG=1:1:$LENGTH(SIG)
IF $LENGTH(^TMP("PSOAL",$JOB,IEN,0)_" "_$PIECE(SIG," ",SG))>80
SET IEN=IEN+1
SET $PIECE(^TMP("PSOAL",$JOB,IEN,0)," ",21)=" "
IF $PIECE(SIG," ",SG)'=""
SET ^TMP("PSOAL",$JOB,IEN,0)=$GET(^TMP("PSOAL",$JOB,IEN,0))_" "_$PIECE(SIG," ",SG)
End DoDot:1
GOTO PTST
+25 SET SIGOK=1
+26 FOR I=0:0
SET I=$ORDER(^PSRX(RXN,"SIG1",I))
IF 'I
QUIT
SET MIG=$PIECE(^PSRX(RXN,"SIG1",I,0),"^")
Begin DoDot:1
+27 FOR SG=1:1:$LENGTH(MIG)
IF $LENGTH(^TMP("PSOAL",$JOB,IEN,0)_" "_$PIECE(MIG," ",SG))>80
SET IEN=IEN+1
SET $PIECE(^TMP("PSOAL",$JOB,IEN,0)," ",21)=" "
IF $PIECE(MIG," ",SG)'=""
SET ^TMP("PSOAL",$JOB,IEN,0)=$GET(^TMP("PSOAL",$JOB,IEN,0))_" "_$PIECE(MIG," ",SG)
End DoDot:1
+28 SET SIGOK=1
KILL MIG,SG
PTST SET $PIECE(RN," ",25)=" "
SET PTST=$SELECT($GET(^PS(53,+$PIECE(RX0,"^",3),0))]"":$PIECE($GET(^PS(53,+$PIECE(RX0,"^",3),0)),"^"),1:"")
SET IEN=IEN+1
+1 SET ^TMP("PSOAL",$JOB,IEN,0)=" Patient Status: "_PTST_$EXTRACT(RN,$LENGTH(PTST)+1,25)
+2 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" Issue Date: "_$EXTRACT($PIECE(RX0,"^",13),4,5)_"/"_$EXTRACT($PIECE(RX0,"^",13),6,7)_"/"_$EXTRACT($PIECE(RX0,"^",13),2,3)
+3 SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_" Fill Date: "_$EXTRACT($PIECE(RX2,"^",2),4,5)_"/"_$EXTRACT($PIECE(RX2,"^",2),6,7)_"/"_$EXTRACT($PIECE(RX2,"^",2),2,3)
+4 SET ROU=$SELECT($PIECE(RX0,"^",11)="W":"Window",1:"Mail")
+5 SET REFL=$PIECE(RX0,"^",9)
SET I=0
FOR
SET I=$ORDER(^PSRX(RXN,1,I))
IF 'I
QUIT
SET REFL=REFL-1
SET ROU=$SELECT($PIECE(^PSRX(RXN,1,I,0),"^",2)="W":"Window",1:"Mail")
+6 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" Last Fill Date: "_$EXTRACT($PIECE(RX3,"^"),4,5)_"/"_$EXTRACT($PIECE(RX3,"^"),6,7)_"/"_$EXTRACT($PIECE(RX3,"^"),2,3)
+7 ;D CMOP^PSOORNE3 S DA=RXN
+8 SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_" ("_ROU_$SELECT($GET(PSOCMOP)]"":", "_PSOCMOP,1:"")_")"
KILL ROU,PSOCMOP
+9 SET IEN=IEN+1
IF $PIECE(RX2,"^",15)
SET ^TMP("PSOAL",$JOB,IEN,0)=" Returned to Stock: "_$EXTRACT($PIECE(RX2,"^",15),4,5)_"/"_$EXTRACT($PIECE(RX2,"^",15),6,7)_"/"_$EXTRACT($PIECE(RX2,"^",15),2,3)
+10 IF '$TEST
SET ^TMP("PSOAL",$JOB,IEN,0)=" Last Release Date: "
Begin DoDot:1
+11 SET RLD=$SELECT($PIECE(RX2,"^",13):$EXTRACT($PIECE(RX2,"^",13),4,5)_"/"_$EXTRACT($PIECE(RX2,"^",13),6,7)_"/"_$EXTRACT($PIECE(RX2,"^",13),2,3),1:"")
+12 IF $ORDER(^PSRX(RXN,1,0))
FOR I=0:0
SET I=$ORDER(^PSRX(RXN,1,I))
IF 'I
QUIT
Begin DoDot:2
+13 IF $PIECE(^PSRX(RXN,1,I,0),"^",18)
SET RLD=$EXTRACT($PIECE(^(0),"^",18),4,5)_"/"_$EXTRACT($PIECE(^(0),"^",18),6,7)_"/"_$EXTRACT($PIECE(^(0),"^",18),2,3)
End DoDot:2
+14 SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_RLD
End DoDot:1
+15 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" Expires: "_$EXTRACT($PIECE(RX2,"^",6),4,5)_"/"_$EXTRACT($PIECE(RX2,"^",6),6,7)_"/"_$EXTRACT($PIECE(RX2,"^",6),2,3)
+16 SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_" Lot #: "_$SELECT($PIECE(RX2,"^",4):$PIECE(RX2,"^",4),1:"")
+17 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" Days Supply: "_$PIECE(RX0,"^",8)_$SELECT($LENGTH($PIECE(RX0,"^",8))=1:" ",1:"")
+18 SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_" QTY"_$SELECT($PIECE($GET(^PSDRUG($PIECE(RX0,"^",6),660)),"^",8)]"":" ("_$PIECE($GET(^PSDRUG($PIECE(RX0,"^",6),660)),"^",8)_")",1:" ( )")_": "_$PIECE(RX0,"^",7)
+19 IF $PIECE($GET(^PSDRUG($PIECE(RX0,"^",6),5)),"^")]""
Begin DoDot:1
+20 SET $PIECE(RN," ",79)=" "
SET IEN=IEN+1
+21 SET ^TMP("PSOAL",$JOB,IEN,0)=$EXTRACT(RN,$LENGTH("QTY DSP MSG: "_$PIECE(^PSDRUG($PIECE(RX0,"^",6),5),"^"))+1,79)_"QTY DSP MSG: "_$PIECE(^PSDRUG($PIECE(RX0,"^",6),5),"^")
KILL RN
End DoDot:1
+22 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" # of Refills: "_$PIECE(RX0,"^",9)_$SELECT($LENGTH($PIECE(RX0,"^",9))=1:" ",1:"")_" Remaining: "_REFL
+23 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" Provider: "_$SELECT($DATA(^VA(200,$PIECE(RX0,"^",4),0)):$PIECE(^VA(200,$PIECE(RX0,"^",4),0),"^"),1:"UNKNOWN")
+24 IF $PIECE(RX3,"^",3)
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" Cos-Provider: "_$PIECE(^VA(200,$PIECE(RX3,"^",3),0),"^")
+25 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" Routing: "_$SELECT($PIECE(RX0,"^",11)="W":"Window",1:"Mail")
+26 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" Copies: "_$SELECT($PIECE(RX0,"^",18):$PIECE(RX0,"^",18),1:1)
+27 IF $PIECE(RX0,"^",11)="W"
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" Method of Pickup: "_$GET(^PSRX(RXN,"MP"))
+28 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" Clinic: "_$SELECT($DATA(^SC(+$PIECE(RX0,"^",5),0)):$PIECE(^SC($PIECE(RX0,"^",5),0),"^"),1:"Not on File")
+29 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" Division: "_$PIECE(^PS(59,$PIECE(RX2,"^",9),0),"^")_" ("_$PIECE(^(0),"^",6)_")"
+30 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" Pharmacist: "_$SELECT($PIECE(RX2,"^",3):$PIECE(^VA(200,$PIECE(RX2,"^",3),0),"^"),1:"")
+31 IF $PIECE(RX2,"^",10)&('$GET(PSOCOPY))
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" Verified By: "_$PIECE(^VA(200,$PIECE(RX2,"^",10),0),"^")
+32 ; IHS/CIA/PLS - 01/25/04 - Removed from display
+33 ;S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" Patient Counseling: "_$S($P($G(^PSRX(RXN,"PC")),"^"):"YES",1:"NO")_" "_$S($P($G(^PSRX(RXN,"PC")),"^"):"Was Counseling Understood: "_$S($P($G(^PSRX(RXN,"PC")),"^",2):"YES",1:"NO"),1:"")
+34 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" Remarks: "_$PIECE(RX3,"^",7)
+35 DO PC^PSORXVW1
+36 IF $PIECE($GET(^PSRX(DA,"OR1")),"^",5)
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" Finished By: "_$PIECE(^VA(200,$PIECE(^PSRX(DA,"OR1"),"^",5),0),"^")
+37 SET $PIECE(RN," ",35)=" "
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" Entry By: "_$PIECE($GET(^VA(200,+$PIECE(RX0,"^",16),0)),"^")_$EXTRACT(RN,$LENGTH($PIECE($GET(^VA(200,+$PIECE(RX0,"^",16),0)),"^"))+1,35)
+38 SET Y=$PIECE(RX2,"^")
XECUTE ^DD("DD")
+39 SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_"Entry Date: "_$EXTRACT($PIECE(RX2,"^"),4,5)_"/"_$EXTRACT($PIECE(RX2,"^"),6,7)_"/"_$EXTRACT($PIECE(RX2,"^"),2,3)_" "_$PIECE(Y,"@",2)
KILL RN
+40 DO ^PSORXVW1
SET PSOAL=IEN
KILL IEN,ACT,LBL,LOG
+41 IF ST<12
IF $PIECE(RX2,"^",6)<DT
SET ST=11
+42 SET ^TMP("PSOAL",$JOB,1,0)=^TMP("PSOAL",$JOB,1,0)_" ("_$PIECE("Error^Active^Non-Verified^Refill^Hold^Non-Verified^Suspended^^^^^Done^Expired^Discontinued^Deleted^Discontinued^Discontinued (Edit)^Provider Hold^","^",ST+2)_")"
+43 IF $PIECE($GET(^PSRX(DA,"PKI")),"^")
SET ^TMP("PSOAL",$JOB,1,0)=^TMP("PSOAL",$JOB,1,0)_" Digitally Signed Order"
+44 ;D EN^PSOORAL,KILL G:PS="VIEW" PSORXVW
+45 DO KILL
+46 QUIT
KILL KILL PS,DA
+1 KILL ^TMP("PSOHDR",$JOB)
+2 KILL ST,RFL,RFLL,RFL1,ST,II,J,N,PHYS,L1,DIRUT,PSDIV,PSEXDT,MED,M1,FFX,DTT,DAT,RX0,RX2,R3,RTN,SIG,STA,P1,PL,P0,Z0,Z1,EXDT,IFN,DIR,DUOUT,DTOUT,PSOELSE
+3 KILL LBL,I,RFDATE,%H,%I,RN,RFT,%,%I,DFN,GMRAL,HDR,POERR,PTST,REFL,RF,RLD,RX3
+4 KILL RXN,RXOR,SG,VA,VADM,VAERR,VALMBCK,VAPA,X,DIC,REA,ZD,PSOHD,PSOBCK,PSODFN,INS1,PSOAL,PSOCOPY,SIGOK
+5 QUIT
+6 ; IHS/CIA/PLS - 01/08/04 - Build IHS data
IHSFLDS ; EP
+1 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" NDC: "_$PIECE(RX2,U,7)
+2 SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_" AWP: "_$$GET1^DIQ(52,RXN,9999999.06)_" UP: "_$$GET1^DIQ(52,RXN,17)
+3 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" TRIPLICATE #: "_$$GET1^DIQ(52,RXN,9999999.14)
+4 QUIT
