ORWRP4P ; slc/dcm - OE/RR HDR Report Extract RPC's Outpatient Pharmacy ;9/21/05 13:21
;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,243**;Dec 17, 1997;Build 242
PSO ;Outpatient RX for HDR
N IFN,IFN1,IFN2,X,X1,X2,X3,X10,X16,X17,XIFN,ORX,COL,CODE,I1,CNT,%DT,Y,FAC,FACU
K ^TMP("ORXS",$J)
S IFN=""
F S IFN=$O(^XTMP(HANDLE,"D",IFN)) Q:IFN="" S XIFN=^(IFN) D
. S X16=$P(XIFN,"^",16),X17=$P(XIFN,"^",17),X2=$P(XIFN,"^",2),FACU=X17
. I X17="",X16,X16'=200 S FACU=$O(^DIC(4,"D",X16,0)) I FACU S FACU=$P(^DIC(4,FACU,0),"^")
. I '$L(FACU) S FACU=$S($L($P(XIFN,"^",2)):$P(XIFN,"^",2),1:"Unknown")
. S $P(XIFN,"^",2)=FACU,X10=$P($P(XIFN,"^",10),":",1,2),X3=$P($P(XIFN,"^",3),"~",2)
. I X3="" S X3=$P($P(XIFN,"^",4),"~",2) ;Get NDC name if Drug name not sent
. I $L(X10),$L(X3) D
.. S X10=9999999-$$SETDATE^ORWRP4(X10),^TMP("ORXS",$J,FACU,X10,X3,IFN)=XIFN
K ^TMP("ORXS1",$J)
S FAC="",CNT=-1
F S FAC=$O(^TMP("ORXS",$J,FAC)) Q:FAC="" S IFN="" F S IFN=$O(^TMP("ORXS",$J,FAC,IFN)) Q:IFN="" D
. S IFN1=""
. F S IFN1=$O(^TMP("ORXS",$J,FAC,IFN,IFN1)) Q:IFN1="" S IFN2="" F S IFN2=$O(^TMP("ORXS",$J,FAC,IFN,IFN1,IFN2)) Q:IFN2="" S X=^(IFN2) D
.. D XSET^ORWRP4("1^"_$P(X,"^",2)) ; Facility
.. D XSET^ORWRP4("2^"_IFN1) ; Drug Name
.. D XSET^ORWRP4("3^"_$P($P(X,"^",3),"~")) ; Drug IEN
.. D XSET^ORWRP4("4^"_$P(X,"^",5)) ; RX #
.. D XSET^ORWRP4("5^"_$P($P(X,"^",6),"~",2)) ; Status
.. D XSET^ORWRP4("6^"_$P(X,"^",7)) ; Qty
.. S Y=$$SETDATE^ORWRP4($P(X,"^",9)) D XSET^ORWRP4("7^"_$$DATE^ORDVU(Y)) ; Exp/Canc Date
.. S Y=$$SETDATE^ORWRP4($P(X,"^",10)) D XSET^ORWRP4("8^"_$$DATE^ORDVU(Y)) ; Issue Date
.. S Y=$$SETDATE^ORWRP4($P(X,"^",11)) D XSET^ORWRP4("9^"_$$DATE^ORDVU(Y)) ; Last Fill Date
.. D XSET^ORWRP4("10^"_$P(X,"^",12)) ; Refills
.. D XSET^ORWRP4("11^"_$P(X,"^",13)) ; Provider
.. D XSET^ORWRP4("12^"_$P(X,"^",14)) ; Cost/Fill
.. D XSET^ORWRP4("13^"_$S($L($P(X,"^",15))>60:"[+]",1:"")) ; [+]
.. D XSET^ORWRP4("14^"_$P(X,"^",15)) ; SIG
K ^XTMP(HANDLE,"D") M ^XTMP(HANDLE,"D")=^TMP("ORXS1",$J) K ^TMP("ORXS",$J),^TMP("ORXS1",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWRP4P 2088 printed Dec 13, 2024@02:37:23 Page 2
ORWRP4P ; slc/dcm - OE/RR HDR Report Extract RPC's Outpatient Pharmacy ;9/21/05 13:21
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,243**;Dec 17, 1997;Build 242
PSO ;Outpatient RX for HDR
+1 NEW IFN,IFN1,IFN2,X,X1,X2,X3,X10,X16,X17,XIFN,ORX,COL,CODE,I1,CNT,%DT,Y,FAC,FACU
+2 KILL ^TMP("ORXS",$JOB)
+3 SET IFN=""
+4 FOR
SET IFN=$ORDER(^XTMP(HANDLE,"D",IFN))
if IFN=""
QUIT
SET XIFN=^(IFN)
Begin DoDot:1
+5 SET X16=$PIECE(XIFN,"^",16)
SET X17=$PIECE(XIFN,"^",17)
SET X2=$PIECE(XIFN,"^",2)
SET FACU=X17
+6 IF X17=""
IF X16
IF X16'=200
SET FACU=$ORDER(^DIC(4,"D",X16,0))
IF FACU
SET FACU=$PIECE(^DIC(4,FACU,0),"^")
+7 IF '$LENGTH(FACU)
SET FACU=$SELECT($LENGTH($PIECE(XIFN,"^",2)):$PIECE(XIFN,"^",2),1:"Unknown")
+8 SET $PIECE(XIFN,"^",2)=FACU
SET X10=$PIECE($PIECE(XIFN,"^",10),":",1,2)
SET X3=$PIECE($PIECE(XIFN,"^",3),"~",2)
+9 ;Get NDC name if Drug name not sent
IF X3=""
SET X3=$PIECE($PIECE(XIFN,"^",4),"~",2)
+10 IF $LENGTH(X10)
IF $LENGTH(X3)
Begin DoDot:2
+11 SET X10=9999999-$$SETDATE^ORWRP4(X10)
SET ^TMP("ORXS",$JOB,FACU,X10,X3,IFN)=XIFN
End DoDot:2
End DoDot:1
+12 KILL ^TMP("ORXS1",$JOB)
+13 SET FAC=""
SET CNT=-1
+14 FOR
SET FAC=$ORDER(^TMP("ORXS",$JOB,FAC))
if FAC=""
QUIT
SET IFN=""
FOR
SET IFN=$ORDER(^TMP("ORXS",$JOB,FAC,IFN))
if IFN=""
QUIT
Begin DoDot:1
+15 SET IFN1=""
+16 FOR
SET IFN1=$ORDER(^TMP("ORXS",$JOB,FAC,IFN,IFN1))
if IFN1=""
QUIT
SET IFN2=""
FOR
SET IFN2=$ORDER(^TMP("ORXS",$JOB,FAC,IFN,IFN1,IFN2))
if IFN2=""
QUIT
SET X=^(IFN2)
Begin DoDot:2
+17 ; Facility
DO XSET^ORWRP4("1^"_$PIECE(X,"^",2))
+18 ; Drug Name
DO XSET^ORWRP4("2^"_IFN1)
+19 ; Drug IEN
DO XSET^ORWRP4("3^"_$PIECE($PIECE(X,"^",3),"~"))
+20 ; RX #
DO XSET^ORWRP4("4^"_$PIECE(X,"^",5))
+21 ; Status
DO XSET^ORWRP4("5^"_$PIECE($PIECE(X,"^",6),"~",2))
+22 ; Qty
DO XSET^ORWRP4("6^"_$PIECE(X,"^",7))
+23 ; Exp/Canc Date
SET Y=$$SETDATE^ORWRP4($PIECE(X,"^",9))
DO XSET^ORWRP4("7^"_$$DATE^ORDVU(Y))
+24 ; Issue Date
SET Y=$$SETDATE^ORWRP4($PIECE(X,"^",10))
DO XSET^ORWRP4("8^"_$$DATE^ORDVU(Y))
+25 ; Last Fill Date
SET Y=$$SETDATE^ORWRP4($PIECE(X,"^",11))
DO XSET^ORWRP4("9^"_$$DATE^ORDVU(Y))
+26 ; Refills
DO XSET^ORWRP4("10^"_$PIECE(X,"^",12))
+27 ; Provider
DO XSET^ORWRP4("11^"_$PIECE(X,"^",13))
+28 ; Cost/Fill
DO XSET^ORWRP4("12^"_$PIECE(X,"^",14))
+29 ; [+]
DO XSET^ORWRP4("13^"_$SELECT($LENGTH($PIECE(X,"^",15))>60:"[+]",1:""))
+30 ; SIG
DO XSET^ORWRP4("14^"_$PIECE(X,"^",15))
End DoDot:2
End DoDot:1
+31 KILL ^XTMP(HANDLE,"D")
MERGE ^XTMP(HANDLE,"D")=^TMP("ORXS1",$JOB)
KILL ^TMP("ORXS",$JOB),^TMP("ORXS1",$JOB)
+32 QUIT
