- 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
- 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
