- 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 Mar 13, 2025@21:35:13 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
