ORDV06B ; slc/dcm - OE/RR Report Extracts ;Aug 19, 2020@08:38:27
;;3.0;ORDER ENTRY RESULTS REPORTING;**312,350,424,428,377,498**;Dec 17, 1997;Build 38
;Pharmacy Extracts for VistaWeb and ALL Medication Report
RXALL(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;All Patient Meds
;Call to PSOORRL
I $L($T(GCPR^OMGCOAS1)) D ; Call if FHIE station 200
. D GCPR^OMGCOAS1(DFN,"RXOP",ORDBEG,ORDEND,9999)
;
N ORRXSTAT,GO
Q:'$L(OREXT)
S GO=$P(OREXT,";")_"^"_$P(OREXT,";",2)
Q:'$L($T(@GO))
S ORRXSTAT=""
D GETMED
Q
IN ;Setup and call to Pharmacy API
;LST(i)=
;LST(i) flags: "~" Start of new record, "/" Continuation line (concatination with Line feed CRLF)
;
;{ 1 2 3 4 5 6 7 8 9 10 11 16
;{ Pieces: Typ^PharmID^Drug^InfRate^StopDt^RefRem^TotDose^UnitDose^OrderID^Status^LastFill^...^StartDt^ }
;If $P($P(X,"^",2),";",2)= "I" or "C" then Inpatient=TRUE
;If $P(X,"^",1)="~NV" then NonVAMed=TRUE and Instruct="Non-VA "_Instruct
;If $E($P(X,"^",1),1,2)="t\" then this is a comment, strip off the 1st character (t) and concatenate to other text
;Location := $P($P(X,U,1),":",2);
K ^TMP("PS",$J),^TMP("ORACT",$J),^TMP("ORPS",$J)
N ORBEG,OREND,ERROR,ORCTX,ORVIEW
S (ORBEG,OREND,ORCTX)=""
S ORVIEW=1
S ORBEG=$S($G(ORDBEG):ORDBEG,1:$$DT^ORWPS("T-50000")),OREND=$S(ORDEND<DT:ORDEND,1:$$DT^ORWPS("T+3000"))
D OCL^PSOORRL(DFN,$$DT^ORWPS("T-50000"),$$DT^ORWPS("T+3000"),ORVIEW)
N ITMP,FIELDS,INSTRUCT,COMMENTS,REASON,NVSDT,TYPE,ILST,J,SORTDT,STOPDT
S ILST=0,ITMP=""
F S ITMP=$O(^TMP("PS",$J,ITMP)) Q:'ITMP D
. K INSTRUCT,COMMENTS,REASON,ORIFN
. K ^TMP("ORACT",$J,"COMMENTS")
. S COMMENTS="^TMP(""ORACT"",$J,""COMMENTS"")"
. S (INSTRUCT,@COMMENTS,STOPDT)="",FIELDS=^TMP("PS",$J,ITMP,0)
. S $P(FIELDS,"^",17)=$P($G(^TMP("PS",$J,ITMP,"P",0)),"^",2) ;Provider
. S SORTDT=$S($L($P(FIELDS,"^",10)):$P(FIELDS,"^",10),1:$P(FIELDS,"^",15)) ;Date Priority: 1)Last Fill Date, 2)Issue/Start Date, 3)Order Date
. I 'SORTDT D ;If pharmacy API doesn't screen out data within selected date range, check CPRS OrderDate to get a StartDate and screen out as appropriate
.. N PSIEN S PSIEN=$P(FIELDS,"^")
.. I $P(PSIEN,";",2)="O",$P(PSIEN,";")["P" S PSIEN=+PSIEN_"S"
.. S PSIEN=$P(PSIEN,";")
.. S ORIFN=+$$PLACER^PSSUTLA1(DFN,PSIEN)
.. I ORIFN S SORTDT=$P($G(^OR(100,ORIFN,0)),"^",7),STOPDT=$P($G(^(0)),"^",9)
. S TYPE=$S($P($P(FIELDS,U),";",2)="O":"OP",1:"UD")
. I $D(^TMP("PS",$J,ITMP,"CLINIC",0)) S TYPE="CP"
. N LOC,LOCEX S (LOC,LOCEX)=""
. I TYPE="CP" S LOC=$G(^TMP("PS",$J,ITMP,"CLINIC",0))
. S:LOC LOCEX=$P($G(^SC(+LOC,0)),U)_":"_+LOC ;IMO
. I TYPE="OP",$P(FIELDS,";")["N" S TYPE="NV" ;non-VA med
. ;Next line excludes any data where (ExpirationDate, LastFill Date, StartDate or OrderDate) is outside of selected date range for everything except non-VAmeds.
. I TYPE'="NV",SORTDT<ORBEG!(SORTDT>OREND),($P(FIELDS,"^",4)<ORBEG!($P(FIELDS,"^",4)>OREND)),($P(FIELDS,"^",10)<ORBEG!($P(FIELDS,"^",10)>OREND)),($P(FIELDS,"^",15)<ORBEG!($P(FIELDS,"^",15)>OREND)) Q
. I $P(FIELDS,"^",9)["DISCONTINUED",(TYPE="OP"!(TYPE="NV")) D
.. I 'STOPDT D
... N PSIEN
... S PSIEN=$P(FIELDS,"^")
... I $P(PSIEN,";",2)="O",$P(PSIEN,";")["P" S PSIEN=+PSIEN_"S"
... S PSIEN=$P(PSIEN,";"),ORIFN=""
... S ORIFN=+$$PLACER^PSSUTLA1(DFN,PSIEN)
... I ORIFN S STOPDT=$P($G(^OR(100,ORIFN,0)),"^",9)
..;
.. I TYPE="NV",'$L($P(FIELDS,"^",4)) S $P(FIELDS,"^",4)=STOPDT
.. I TYPE="OP" S $P(FIELDS,"^",4)=STOPDT
. I $O(^TMP("PS",$J,ITMP,"A",0))>0 S TYPE="IV"
. I $O(^TMP("PS",$J,ITMP,"B",0))>0 S TYPE="IV"
. I (TYPE="UD")!(TYPE="CP") D UDINST^ORWPS(.INSTRUCT,ITMP)
. I TYPE="OP" D OPINST^ORWPS(.INSTRUCT,ITMP)
. I TYPE="IV" D IVINST^ORWPS(.INSTRUCT,ITMP)
. I TYPE="NV" D NVINST^ORWPS(.INSTRUCT,ITMP),NVREASON^ORWPS(.REASON,.NVSDT,ITMP)
. I (TYPE="UD")!(TYPE="IV")!(TYPE="NV")!(TYPE="CP") D SETMULT^ORWPS(COMMENTS,ITMP,"SIO")
. M COMMENTS=@COMMENTS
. I $D(COMMENTS(1)) S COMMENTS(1)="\"_COMMENTS(1)
. I '$L($P(FIELDS,U,15)) S:TYPE="NV" $P(FIELDS,U,15)=$P($G(NVSDT),".") ;Set Start Date for non-VA Med (from file 100, which currently doesn't get set)
. I LOC S ^TMP("ORPS",$J,$$NXT)="~CP:"_LOCEX_U_FIELDS
. E S ^TMP("ORPS",$J,$$NXT)="~"_TYPE_U_FIELDS
. S J=0 F S J=$O(INSTRUCT(J)) Q:'J S ^TMP("ORPS",$J,$$NXT)=INSTRUCT(J)
. S J=0 F S J=$O(COMMENTS(J)) Q:'J S ^TMP("ORPS",$J,$$NXT)="t"_COMMENTS(J)
. S J=0 F S J=$O(REASON(J)) Q:'J S ^TMP("ORPS",$J,$$NXT)="t"_REASON(J)
K ^TMP("PS",$J),^TMP("ORACT",$J)
Q
NXT() ; increment ILST
S ILST=ILST+1
Q ILST
;
GETMED ;
N J,ORIPS,ORIPSS,ORDRGIEN,ORDRG,ORRXNO,ORSTAT,ORQTY,OREXP,ORISSUE,ORLAST,ORREF,ORPRVD,ORCOST,ORSIG,ORT,ORX0
N ECD,GMR,GMW,IX,PSOBEGIN,GMTSNDM,GMTS1,GMTS2,ORSITE,SITE,X,NONVA,INST,OLDORI,RT,X,X2,X3,ORII,ORKK
S ORSITE=$$SITE^VASITE,ORSITE=$P(ORSITE,"^",2)_";"_$P(ORSITE,"^",3)
;Sorted by STATUS then by DRUG NAME
K ^TMP("ORDATA",$J),^TMP("ORXPND",$J),^TMP("ORT",$J)
I '$L($T(GCPR^OMGCOAS1)) D
. K ^TMP("ORPS",$J)
. D @GO
S (OLDORI,ORIPS,ORT)=0
F S ORIPS=$O(^TMP("ORPS",$J,ORIPS)) Q:(ORIPS'>0) S X=$G(^(ORIPS)) I X'="" D
. I $E(X)="~" D Q
.. S OLDORI=ORIPS,ORT=0,X3=$S($L($P(X,"^",10)):$P(X,"^",10),1:"ZUNKNOWN"),X2=$S($L($P(X,"^",3)):$P(X,"^",3),1:"ZUNKNOWN")
.. S ^TMP("ORT",$J,X3,X2,ORIPS)=X
. I $L(X2),$L(X3),$E(X)="\" S ORT=ORT+1,^TMP("ORT",$J,X3,X2,OLDORI,ORT)=$E(X,2,9999)
S ORII=""
F S ORII=$O(^TMP("ORT",$J,ORII)) Q:ORII="" S ORKK="" F S ORKK=$O(^TMP("ORT",$J,ORII,ORKK)) Q:ORKK="" D
. S ORIPS=0 F S ORIPS=$O(^TMP("ORT",$J,ORII,ORKK,ORIPS)) Q:(ORIPS'>0) S ORX0=^(ORIPS) D
.. I $E(ORX0)="~" D Q
... S ORIPSS=$S($L($P(ORX0,U,10)):$E($P(ORX0,U,10),1,10),1:"UNK")_"_"_$S($L($P(ORX0,U,3)):$P(ORX0,U,3),1:"UNK")_"_"_ORIPS
... S ^TMP("ORDATA",$J,ORIPSS,"WP",1)="1^"_ORSITE ;Station ID
... S ^TMP("ORDATA",$J,ORIPSS,"WP",2)="2^"_$P(ORX0,U,3) ;Medication Name
... S ^TMP("ORDATA",$J,ORIPSS,"WP",3)="3^"_$P(ORX0,U,10) ;Status
... S X=$P($P(ORX0,"^",2),";",2),^TMP("ORDATA",$J,ORIPSS,"WP",4)="4^"_$S(X="I":"IN",X="C":"IN",1:"OUT") ;In/OutPatient
... S X=$P(ORX0,"^"),^TMP("ORDATA",$J,ORIPSS,"WP",5)="5^"_$S(X="~NV":"NonVAMed",1:"RX") ;Type: RX or NonVA Med
... S ^TMP("ORDATA",$J,ORIPSS,"WP",6)="6^"_$$DATE^ORDVU($P(ORX0,U,16)) ;Start Date
... S ^TMP("ORDATA",$J,ORIPSS,"WP",7)="7^"_$$DATE^ORDVU($P(ORX0,U,5)) ;Stop Date
... S ^TMP("ORDATA",$J,ORIPSS,"WP",8)="8^"_$$DATE^ORDVU($P(ORX0,U,11)) ;Last Fill Date
... S ^TMP("ORDATA",$J,ORIPSS,"WP",9)="9^"_$P(ORX0,U,18) ;Provider
... S ^TMP("ORDATA",$J,ORIPSS,"WP",12)="12^[+]" ;flag for detail
... S X=$P(ORX0,"^",2) D DETAIL^ORWPS(.RT,DFN,X)
... S J=0 F S J=$O(^TMP("ORXPND",$J,J)) Q:'J S X=^(J,0),^TMP("ORDATA",$J,ORIPSS,"WP",11,J)="11^"_X ;Details from Order
... K ^TMP("ORXPND",$J)
... S ORT=0 F S ORT=$O(^TMP("ORT",$J,ORII,ORKK,ORIPS,ORT)) Q:'ORT S X=^(ORT),^TMP("ORDATA",$J,ORIPSS,"WP",10,ORT)="10^"_X ;Instructions
K ^TMP("ORPS",$J),^TMP("ORXPND",$J),^TMP("ORT",$J)
S ROOT=$NA(^TMP("ORDATA",$J))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORDV06B 7069 printed Apr 09, 2024@21:25:47 Page 2
ORDV06B ; slc/dcm - OE/RR Report Extracts ;Aug 19, 2020@08:38:27
+1 ;;3.0;ORDER ENTRY RESULTS REPORTING;**312,350,424,428,377,498**;Dec 17, 1997;Build 38
+2 ;Pharmacy Extracts for VistaWeb and ALL Medication Report
RXALL(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;All Patient Meds
+1 ;Call to PSOORRL
+2 ; Call if FHIE station 200
IF $LENGTH($TEXT(GCPR^OMGCOAS1))
Begin DoDot:1
+3 DO GCPR^OMGCOAS1(DFN,"RXOP",ORDBEG,ORDEND,9999)
End DoDot:1
+4 ;
+5 NEW ORRXSTAT,GO
+6 if '$LENGTH(OREXT)
QUIT
+7 SET GO=$PIECE(OREXT,";")_"^"_$PIECE(OREXT,";",2)
+8 if '$LENGTH($TEXT(@GO))
QUIT
+9 SET ORRXSTAT=""
+10 DO GETMED
+11 QUIT
IN ;Setup and call to Pharmacy API
+1 ;LST(i)=
+2 ;LST(i) flags: "~" Start of new record, "/" Continuation line (concatination with Line feed CRLF)
+3 ;
+4 ;{ 1 2 3 4 5 6 7 8 9 10 11 16
+5 ;{ Pieces: Typ^PharmID^Drug^InfRate^StopDt^RefRem^TotDose^UnitDose^OrderID^Status^LastFill^...^StartDt^ }
+6 ;If $P($P(X,"^",2),";",2)= "I" or "C" then Inpatient=TRUE
+7 ;If $P(X,"^",1)="~NV" then NonVAMed=TRUE and Instruct="Non-VA "_Instruct
+8 ;If $E($P(X,"^",1),1,2)="t\" then this is a comment, strip off the 1st character (t) and concatenate to other text
+9 ;Location := $P($P(X,U,1),":",2);
+10 KILL ^TMP("PS",$JOB),^TMP("ORACT",$JOB),^TMP("ORPS",$JOB)
+11 NEW ORBEG,OREND,ERROR,ORCTX,ORVIEW
+12 SET (ORBEG,OREND,ORCTX)=""
+13 SET ORVIEW=1
+14 SET ORBEG=$SELECT($GET(ORDBEG):ORDBEG,1:$$DT^ORWPS("T-50000"))
SET OREND=$SELECT(ORDEND<DT:ORDEND,1:$$DT^ORWPS("T+3000"))
+15 DO OCL^PSOORRL(DFN,$$DT^ORWPS("T-50000"),$$DT^ORWPS("T+3000"),ORVIEW)
+16 NEW ITMP,FIELDS,INSTRUCT,COMMENTS,REASON,NVSDT,TYPE,ILST,J,SORTDT,STOPDT
+17 SET ILST=0
SET ITMP=""
+18 FOR
SET ITMP=$ORDER(^TMP("PS",$JOB,ITMP))
if 'ITMP
QUIT
Begin DoDot:1
+19 KILL INSTRUCT,COMMENTS,REASON,ORIFN
+20 KILL ^TMP("ORACT",$JOB,"COMMENTS")
+21 SET COMMENTS="^TMP(""ORACT"",$J,""COMMENTS"")"
+22 SET (INSTRUCT,@COMMENTS,STOPDT)=""
SET FIELDS=^TMP("PS",$JOB,ITMP,0)
+23 ;Provider
SET $PIECE(FIELDS,"^",17)=$PIECE($GET(^TMP("PS",$JOB,ITMP,"P",0)),"^",2)
+24 ;Date Priority: 1)Last Fill Date, 2)Issue/Start Date, 3)Order Date
SET SORTDT=$SELECT($LENGTH($PIECE(FIELDS,"^",10)):$PIECE(FIELDS,"^",10),1:$PIECE(FIELDS,"^",15))
+25 ;If pharmacy API doesn't screen out data within selected date range, check CPRS OrderDate to get a StartDate and screen out as appropriate
IF 'SORTDT
Begin DoDot:2
+26 NEW PSIEN
SET PSIEN=$PIECE(FIELDS,"^")
+27 IF $PIECE(PSIEN,";",2)="O"
IF $PIECE(PSIEN,";")["P"
SET PSIEN=+PSIEN_"S"
+28 SET PSIEN=$PIECE(PSIEN,";")
+29 SET ORIFN=+$$PLACER^PSSUTLA1(DFN,PSIEN)
+30 IF ORIFN
SET SORTDT=$PIECE($GET(^OR(100,ORIFN,0)),"^",7)
SET STOPDT=$PIECE($GET(^(0)),"^",9)
End DoDot:2
+31 SET TYPE=$SELECT($PIECE($PIECE(FIELDS,U),";",2)="O":"OP",1:"UD")
+32 IF $DATA(^TMP("PS",$JOB,ITMP,"CLINIC",0))
SET TYPE="CP"
+33 NEW LOC,LOCEX
SET (LOC,LOCEX)=""
+34 IF TYPE="CP"
SET LOC=$GET(^TMP("PS",$JOB,ITMP,"CLINIC",0))
+35 ;IMO
if LOC
SET LOCEX=$PIECE($GET(^SC(+LOC,0)),U)_":"_+LOC
+36 ;non-VA med
IF TYPE="OP"
IF $PIECE(FIELDS,";")["N"
SET TYPE="NV"
+37 ;Next line excludes any data where (ExpirationDate, LastFill Date, StartDate or OrderDate) is outside of selected date range for everything except non-VAmeds.
+38 IF TYPE'="NV"
IF SORTDT<ORBEG!(SORTDT>OREND)
IF ($PIECE(FIELDS,"^",4)<ORBEG!($PIECE(FIELDS,"^",4)>OREND))
IF ($PIECE(FIELDS,"^",10)<ORBEG!($PIECE(FIELDS,"^",10)>OREND))
IF ($PIECE(FIELDS,"^",15)<ORBEG!($PIECE(FIELDS,"^",15)>OREND))
QUIT
+39 IF $PIECE(FIELDS,"^",9)["DISCONTINUED"
IF (TYPE="OP"!(TYPE="NV"))
Begin DoDot:2
+40 IF 'STOPDT
Begin DoDot:3
+41 NEW PSIEN
+42 SET PSIEN=$PIECE(FIELDS,"^")
+43 IF $PIECE(PSIEN,";",2)="O"
IF $PIECE(PSIEN,";")["P"
SET PSIEN=+PSIEN_"S"
+44 SET PSIEN=$PIECE(PSIEN,";")
SET ORIFN=""
+45 SET ORIFN=+$$PLACER^PSSUTLA1(DFN,PSIEN)
+46 IF ORIFN
SET STOPDT=$PIECE($GET(^OR(100,ORIFN,0)),"^",9)
End DoDot:3
+47 ;
+48 IF TYPE="NV"
IF '$LENGTH($PIECE(FIELDS,"^",4))
SET $PIECE(FIELDS,"^",4)=STOPDT
+49 IF TYPE="OP"
SET $PIECE(FIELDS,"^",4)=STOPDT
End DoDot:2
+50 IF $ORDER(^TMP("PS",$JOB,ITMP,"A",0))>0
SET TYPE="IV"
+51 IF $ORDER(^TMP("PS",$JOB,ITMP,"B",0))>0
SET TYPE="IV"
+52 IF (TYPE="UD")!(TYPE="CP")
DO UDINST^ORWPS(.INSTRUCT,ITMP)
+53 IF TYPE="OP"
DO OPINST^ORWPS(.INSTRUCT,ITMP)
+54 IF TYPE="IV"
DO IVINST^ORWPS(.INSTRUCT,ITMP)
+55 IF TYPE="NV"
DO NVINST^ORWPS(.INSTRUCT,ITMP)
DO NVREASON^ORWPS(.REASON,.NVSDT,ITMP)
+56 IF (TYPE="UD")!(TYPE="IV")!(TYPE="NV")!(TYPE="CP")
DO SETMULT^ORWPS(COMMENTS,ITMP,"SIO")
+57 MERGE COMMENTS=@COMMENTS
+58 IF $DATA(COMMENTS(1))
SET COMMENTS(1)="\"_COMMENTS(1)
+59 ;Set Start Date for non-VA Med (from file 100, which currently doesn't get set)
IF '$LENGTH($PIECE(FIELDS,U,15))
if TYPE="NV"
SET $PIECE(FIELDS,U,15)=$PIECE($GET(NVSDT),".")
+60 IF LOC
SET ^TMP("ORPS",$JOB,$$NXT)="~CP:"_LOCEX_U_FIELDS
+61 IF '$TEST
SET ^TMP("ORPS",$JOB,$$NXT)="~"_TYPE_U_FIELDS
+62 SET J=0
FOR
SET J=$ORDER(INSTRUCT(J))
if 'J
QUIT
SET ^TMP("ORPS",$JOB,$$NXT)=INSTRUCT(J)
+63 SET J=0
FOR
SET J=$ORDER(COMMENTS(J))
if 'J
QUIT
SET ^TMP("ORPS",$JOB,$$NXT)="t"_COMMENTS(J)
+64 SET J=0
FOR
SET J=$ORDER(REASON(J))
if 'J
QUIT
SET ^TMP("ORPS",$JOB,$$NXT)="t"_REASON(J)
End DoDot:1
+65 KILL ^TMP("PS",$JOB),^TMP("ORACT",$JOB)
+66 QUIT
NXT() ; increment ILST
+1 SET ILST=ILST+1
+2 QUIT ILST
+3 ;
GETMED ;
+1 NEW J,ORIPS,ORIPSS,ORDRGIEN,ORDRG,ORRXNO,ORSTAT,ORQTY,OREXP,ORISSUE,ORLAST,ORREF,ORPRVD,ORCOST,ORSIG,ORT,ORX0
+2 NEW ECD,GMR,GMW,IX,PSOBEGIN,GMTSNDM,GMTS1,GMTS2,ORSITE,SITE,X,NONVA,INST,OLDORI,RT,X,X2,X3,ORII,ORKK
+3 SET ORSITE=$$SITE^VASITE
SET ORSITE=$PIECE(ORSITE,"^",2)_";"_$PIECE(ORSITE,"^",3)
+4 ;Sorted by STATUS then by DRUG NAME
+5 KILL ^TMP("ORDATA",$JOB),^TMP("ORXPND",$JOB),^TMP("ORT",$JOB)
+6 IF '$LENGTH($TEXT(GCPR^OMGCOAS1))
Begin DoDot:1
+7 KILL ^TMP("ORPS",$JOB)
+8 DO @GO
End DoDot:1
+9 SET (OLDORI,ORIPS,ORT)=0
+10 FOR
SET ORIPS=$ORDER(^TMP("ORPS",$JOB,ORIPS))
if (ORIPS'>0)
QUIT
SET X=$GET(^(ORIPS))
IF X'=""
Begin DoDot:1
+11 IF $EXTRACT(X)="~"
Begin DoDot:2
+12 SET OLDORI=ORIPS
SET ORT=0
SET X3=$SELECT($LENGTH($PIECE(X,"^",10)):$PIECE(X,"^",10),1:"ZUNKNOWN")
SET X2=$SELECT($LENGTH($PIECE(X,"^",3)):$PIECE(X,"^",3),1:"ZUNKNOWN")
+13 SET ^TMP("ORT",$JOB,X3,X2,ORIPS)=X
End DoDot:2
QUIT
+14 IF $LENGTH(X2)
IF $LENGTH(X3)
IF $EXTRACT(X)="\"
SET ORT=ORT+1
SET ^TMP("ORT",$JOB,X3,X2,OLDORI,ORT)=$EXTRACT(X,2,9999)
End DoDot:1
+15 SET ORII=""
+16 FOR
SET ORII=$ORDER(^TMP("ORT",$JOB,ORII))
if ORII=""
QUIT
SET ORKK=""
FOR
SET ORKK=$ORDER(^TMP("ORT",$JOB,ORII,ORKK))
if ORKK=""
QUIT
Begin DoDot:1
+17 SET ORIPS=0
FOR
SET ORIPS=$ORDER(^TMP("ORT",$JOB,ORII,ORKK,ORIPS))
if (ORIPS'>0)
QUIT
SET ORX0=^(ORIPS)
Begin DoDot:2
+18 IF $EXTRACT(ORX0)="~"
Begin DoDot:3
+19 SET ORIPSS=$SELECT($LENGTH($PIECE(ORX0,U,10)):$EXTRACT($PIECE(ORX0,U,10),1,10),1:"UNK")_"_"_$SELECT($LENGTH($PIECE(ORX0,U,3)):$PIECE(ORX0,U,3),1:"UNK")_"_"_ORIPS
+20 ;Station ID
SET ^TMP("ORDATA",$JOB,ORIPSS,"WP",1)="1^"_ORSITE
+21 ;Medication Name
SET ^TMP("ORDATA",$JOB,ORIPSS,"WP",2)="2^"_$PIECE(ORX0,U,3)
+22 ;Status
SET ^TMP("ORDATA",$JOB,ORIPSS,"WP",3)="3^"_$PIECE(ORX0,U,10)
+23 ;In/OutPatient
SET X=$PIECE($PIECE(ORX0,"^",2),";",2)
SET ^TMP("ORDATA",$JOB,ORIPSS,"WP",4)="4^"_$SELECT(X="I":"IN",X="C":"IN",1:"OUT")
+24 ;Type: RX or NonVA Med
SET X=$PIECE(ORX0,"^")
SET ^TMP("ORDATA",$JOB,ORIPSS,"WP",5)="5^"_$SELECT(X="~NV":"NonVAMed",1:"RX")
+25 ;Start Date
SET ^TMP("ORDATA",$JOB,ORIPSS,"WP",6)="6^"_$$DATE^ORDVU($PIECE(ORX0,U,16))
+26 ;Stop Date
SET ^TMP("ORDATA",$JOB,ORIPSS,"WP",7)="7^"_$$DATE^ORDVU($PIECE(ORX0,U,5))
+27 ;Last Fill Date
SET ^TMP("ORDATA",$JOB,ORIPSS,"WP",8)="8^"_$$DATE^ORDVU($PIECE(ORX0,U,11))
+28 ;Provider
SET ^TMP("ORDATA",$JOB,ORIPSS,"WP",9)="9^"_$PIECE(ORX0,U,18)
+29 ;flag for detail
SET ^TMP("ORDATA",$JOB,ORIPSS,"WP",12)="12^[+]"
+30 SET X=$PIECE(ORX0,"^",2)
DO DETAIL^ORWPS(.RT,DFN,X)
+31 ;Details from Order
SET J=0
FOR
SET J=$ORDER(^TMP("ORXPND",$JOB,J))
if 'J
QUIT
SET X=^(J,0)
SET ^TMP("ORDATA",$JOB,ORIPSS,"WP",11,J)="11^"_X
+32 KILL ^TMP("ORXPND",$JOB)
+33 ;Instructions
SET ORT=0
FOR
SET ORT=$ORDER(^TMP("ORT",$JOB,ORII,ORKK,ORIPS,ORT))
if 'ORT
QUIT
SET X=^(ORT)
SET ^TMP("ORDATA",$JOB,ORIPSS,"WP",10,ORT)="10^"_X
End DoDot:3
QUIT
End DoDot:2
End DoDot:1
+34 KILL ^TMP("ORPS",$JOB),^TMP("ORXPND",$JOB),^TMP("ORT",$JOB)
+35 SET ROOT=$NAME(^TMP("ORDATA",$JOB))
+36 QUIT
