ORDV06D ; SLC/JAS - OE/RR Report Extracts ;Oct 23, 2020@12:12:49
;;3.0;ORDER ENTRY RESULTS REPORTING;**539**;Dec 17, 1997;Build 41
;
;Pharmacy Extracts for CPRS Active Meds w/ Allergies Report
;Copied from ORDV06B and modified to specific report needs
;
; DBIA 3239 ^PSSUTIL1
; DBIA 2400 ^PSOORRL
; DBIA 10112 $$SITE^VASITE
; DBIA 3486 GCPR^OMGCOAS1
; DBIA 2378 ORCHK2^GMRAOR
;
RXACT(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;All Active 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=3 I $G(ORDEND)="" S ORDEND=DT
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)
. I $P(FIELDS,"^",9)["DISCONTINUED"!($P(FIELDS,"^",9)["EXPIRED")!($P(FIELDS,"^",9)["CANCELLED") Q
. 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 and screen out as appropriate
.. K ^TMP("ORXPS",$J) M ^TMP("ORXPS",$J)=^TMP("PS",$J)
.. D OEL^PSOORRL(DFN,$P(FIELDS,"^")) ;This API uses same ^TMP("PS" global
.. S ORIFN=+$P(^TMP("PS",$J,0),"^",11) I ORIFN S SORTDT=$P(^OR(100,ORIFN,0),"^",7),STOPDT=$P(^(0),"^",9)
.. M ^TMP("PS",$J)=^TMP("ORXPS",$J) K ^TMP("ORXPS",$J)
. 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
.. K ^TMP("ORXPS",$J) M ^TMP("ORXPS",$J)=^TMP("PS",$J)
.. D OEL^PSOORRL(DFN,$P(FIELDS,"^")) ;This API uses same ^TMP("PS" global
.. S ORIFN=+$P(^TMP("PS",$J,0),"^",11) I ORIFN S STOPDT=$P(^OR(100,ORIFN,0),"^",9)
.. M ^TMP("PS",$J)=^TMP("ORXPS",$J) K ^TMP("ORXPS",$J)
.. 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,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
N AFND,ORORD,ILST
S ORSITE=$$SITE^VASITE,ORSITE=$P(ORSITE,"^",2)_";"_$P(ORSITE,"^",3)
;Sorted by STATUS then by DRUG NAME
K ^TMP("ORDATA",$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),AFND=0 D
.. I $E(ORX0)="~" D Q
... S ORPSPKG=$P($P(ORX0,U,2),";",2) ; mwa needed for FNDDRG^ORWDXC in ACHK
... 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 ORORD=$P($P(ORX0,U,9),";") D ACHK Q:'AFND
... 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 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
ACHK ; Order check for drug allergies
N ORIDA,ORORI,ORPXI,ILST,ORKDD,ORPSA,ORII,ORX
Q:'$D(^OR(100,ORORD,.1))
S ILST=1
D FNDDRG^ORWDXC(.ORX,+ORORD,ORPSPKG)
S ORII="" F S ORII=$O(ORX(ORII)) Q:'ORII D
.N NPTR,LPTR,HL7,OI
. S OI=$P(ORX(ORII),"|")
. S HL7=$P(ORX(ORII),"|",3)
. S NPTR=$P(HL7,U)
. S LPTR=$P(HL7,U,4)
. I '$L($G(LPTR)) D Q
..D OI2DD(.ORPSA,OI,ORPSPKG)
..S ORKDD="" F S ORKDD=$O(ORPSA(ORKDD)) Q:'ORKDD D
...S NPTR=$P(ORKDD,";",2)
...S LPTR=+ORKDD
...S AFND=$$ORCHK2^GMRAOR(DFN,"DR",$G(NPTR)_$S($G(NPTR)'[".":".",1:"")_"."_LPTR,"","ORALL")
...I AFND D ADETAIL
.S AFND=$$ORCHK2^GMRAOR(DFN,"DR",$G(NPTR)_$S($G(NPTR)'[".":".",1:"")_"."_LPTR,"","ORALL") ; ICR 2378
.I AFND D ADETAIL
Q
ADETAIL ;
; Set detail lines from ORALL array
N ADA,ASDA,ASEVDA
S ^TMP("ORDATA",$J,ORIPSS,"WP",11,$$NXT)="11^"
F ADA=1:1:ORALL I $D(ORALL(ADA,"MESSAGE")) D
. S ^TMP("ORDATA",$J,ORIPSS,"WP",11,$$NXT)="11^ Causative agent: "_$P(ORALL(ADA,"MESSAGE",2),"^",2)
. S ^TMP("ORDATA",$J,ORIPSS,"WP",11,$$NXT)="11^"
. S ^TMP("ORDATA",$J,ORIPSS,"WP",11,$$NXT)="11^ Symptons: "_$P(ORALL(ADA,"MESSAGE",2),"^",1)
. S ^TMP("ORDATA",$J,ORIPSS,"WP",11,$$NXT)="11^ Drug Class: "_$G(ORALL(ADA,"MESSAGE","OFFENDERS","CLS"))
. S ^TMP("ORDATA",$J,ORIPSS,"WP",11,$$NXT)="11^"
. S ASDA="" F S ASDA=$O(ORALL(ADA,"MESSAGE",1,ASDA)) Q:ASDA="" I $D(ORALL(ADA,"MESSAGE",1,ASDA)) D
. . S ^TMP("ORDATA",$J,ORIPSS,"WP",11,$$NXT)="11^ Originator: "_$P(ORALL(ADA,"MESSAGE",1,ASDA),"^",1)
. . S ^TMP("ORDATA",$J,ORIPSS,"WP",11,$$NXT)="11^ Originated: "_$P(ORALL(ADA,"MESSAGE",1,ASDA),"^",3)
. . S ^TMP("ORDATA",$J,ORIPSS,"WP",11,$$NXT)="11^Observed/Historical: "_$P(ORALL(ADA,"MESSAGE",1,ASDA),"^",4)
. . I $D(ORALL(ADA,"MESSAGE",1,ASDA,1)) S ASEVDA="" F S ASEVDA=$O(ORALL(ADA,"MESSAGE",1,ASDA,1,ASEVDA)) Q:ASEVDA="" I $D(ORALL(ADA,"MESSAGE",1,ASDA,1,ASEVDA)) D
. . . S ^TMP("ORDATA",$J,ORIPSS,"WP",11,$$NXT)="11^ Obs Dates/Severity: "_$P(ORALL(ADA,"MESSAGE",1,ASDA,1,ASEVDA),"^",1)_" - "_$P(ORALL(ADA,"MESSAGE",1,ASDA,1,ASEVDA),"^",2)
. S ^TMP("ORDATA",$J,ORIPSS,"WP",11,$$NXT)="11^"
. S ^TMP("ORDATA",$J,ORIPSS,"WP",11,$$NXT)="11^-------------------------------------------------------"
. S ^TMP("ORDATA",$J,ORIPSS,"WP",11,$$NXT)="11^"
Q
OI2DD(ORPSA,OROI,ORPSPKG) ;
N PSOI
Q:'$D(^ORD(101.43,OROI,0))
S PSOI=$P($P(^ORD(101.43,OROI,0),U,2),";")
Q:+$G(PSOI)<1
D DRG^PSSUTIL1(.ORPSA,PSOI,ORPSPKG)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORDV06D 9841 printed Oct 16, 2024@18:30:54 Page 2
ORDV06D ; SLC/JAS - OE/RR Report Extracts ;Oct 23, 2020@12:12:49
+1 ;;3.0;ORDER ENTRY RESULTS REPORTING;**539**;Dec 17, 1997;Build 41
+2 ;
+3 ;Pharmacy Extracts for CPRS Active Meds w/ Allergies Report
+4 ;Copied from ORDV06B and modified to specific report needs
+5 ;
+6 ; DBIA 3239 ^PSSUTIL1
+7 ; DBIA 2400 ^PSOORRL
+8 ; DBIA 10112 $$SITE^VASITE
+9 ; DBIA 3486 GCPR^OMGCOAS1
+10 ; DBIA 2378 ORCHK2^GMRAOR
+11 ;
RXACT(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;All Active 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=3
IF $GET(ORDEND)=""
SET ORDEND=DT
+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 IF $PIECE(FIELDS,"^",9)["DISCONTINUED"!($PIECE(FIELDS,"^",9)["EXPIRED")!($PIECE(FIELDS,"^",9)["CANCELLED")
QUIT
+24 ;Provider
SET $PIECE(FIELDS,"^",17)=$PIECE($GET(^TMP("PS",$JOB,ITMP,"P",0)),"^",2)
+25 ;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))
+26 ;If pharmacy API doesn't screen out data within selected date range, check CPRS OrderDate and screen out as appropriate
IF 'SORTDT
Begin DoDot:2
+27 KILL ^TMP("ORXPS",$JOB)
MERGE ^TMP("ORXPS",$JOB)=^TMP("PS",$JOB)
+28 ;This API uses same ^TMP("PS" global
DO OEL^PSOORRL(DFN,$PIECE(FIELDS,"^"))
+29 SET ORIFN=+$PIECE(^TMP("PS",$JOB,0),"^",11)
IF ORIFN
SET SORTDT=$PIECE(^OR(100,ORIFN,0),"^",7)
SET STOPDT=$PIECE(^(0),"^",9)
+30 MERGE ^TMP("PS",$JOB)=^TMP("ORXPS",$JOB)
KILL ^TMP("ORXPS",$JOB)
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 KILL ^TMP("ORXPS",$JOB)
MERGE ^TMP("ORXPS",$JOB)=^TMP("PS",$JOB)
+41 ;This API uses same ^TMP("PS" global
DO OEL^PSOORRL(DFN,$PIECE(FIELDS,"^"))
+42 SET ORIFN=+$PIECE(^TMP("PS",$JOB,0),"^",11)
IF ORIFN
SET STOPDT=$PIECE(^OR(100,ORIFN,0),"^",9)
+43 MERGE ^TMP("PS",$JOB)=^TMP("ORXPS",$JOB)
KILL ^TMP("ORXPS",$JOB)
+44 IF TYPE="NV"
IF '$LENGTH($PIECE(FIELDS,"^",4))
SET $PIECE(FIELDS,"^",4)=STOPDT
+45 IF TYPE="OP"
SET $PIECE(FIELDS,"^",4)=STOPDT
End DoDot:2
+46 IF $ORDER(^TMP("PS",$JOB,ITMP,"A",0))>0
SET TYPE="IV"
+47 IF $ORDER(^TMP("PS",$JOB,ITMP,"B",0))>0
SET TYPE="IV"
+48 IF (TYPE="UD")!(TYPE="CP")
DO UDINST^ORWPS(.INSTRUCT,ITMP)
+49 IF TYPE="OP"
DO OPINST^ORWPS(.INSTRUCT,ITMP)
+50 IF TYPE="IV"
DO IVINST^ORWPS(.INSTRUCT,ITMP)
+51 IF TYPE="NV"
DO NVINST^ORWPS(.INSTRUCT,ITMP)
DO NVREASON^ORWPS(.REASON,.NVSDT,ITMP)
+52 IF (TYPE="UD")!(TYPE="IV")!(TYPE="NV")!(TYPE="CP")
DO SETMULT^ORWPS(COMMENTS,ITMP,"SIO")
+53 MERGE COMMENTS=@COMMENTS
+54 IF $DATA(COMMENTS(1))
SET COMMENTS(1)="\"_COMMENTS(1)
+55 ;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),".")
+56 IF LOC
SET ^TMP("ORPS",$JOB,$$NXT)="~CP:"_LOCEX_U_FIELDS
+57 IF '$TEST
SET ^TMP("ORPS",$JOB,$$NXT)="~"_TYPE_U_FIELDS
+58 SET J=0
FOR
SET J=$ORDER(INSTRUCT(J))
if 'J
QUIT
SET ^TMP("ORPS",$JOB,$$NXT)=INSTRUCT(J)
+59 SET J=0
FOR
SET J=$ORDER(COMMENTS(J))
if 'J
QUIT
SET ^TMP("ORPS",$JOB,$$NXT)="t"_COMMENTS(J)
+60 SET J=0
FOR
SET J=$ORDER(REASON(J))
if 'J
QUIT
SET ^TMP("ORPS",$JOB,$$NXT)="t"_REASON(J)
End DoDot:1
+61 KILL ^TMP("PS",$JOB),^TMP("ORACT",$JOB)
+62 QUIT
NXT() ; increment ILST
+1 SET ILST=ILST+1
+2 QUIT ILST
+3 ;
GETMED ;
+1 NEW J,ORIPS,ORIPSS,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 NEW AFND,ORORD,ILST
+4 SET ORSITE=$$SITE^VASITE
SET ORSITE=$PIECE(ORSITE,"^",2)_";"_$PIECE(ORSITE,"^",3)
+5 ;Sorted by STATUS then by DRUG NAME
+6 KILL ^TMP("ORDATA",$JOB),^TMP("ORT",$JOB)
+7 IF '$LENGTH($TEXT(GCPR^OMGCOAS1))
Begin DoDot:1
+8 KILL ^TMP("ORPS",$JOB)
+9 DO @GO
End DoDot:1
+10 SET (OLDORI,ORIPS,ORT)=0
+11 FOR
SET ORIPS=$ORDER(^TMP("ORPS",$JOB,ORIPS))
if (ORIPS'>0)
QUIT
SET X=$GET(^(ORIPS))
IF X'=""
Begin DoDot:1
+12 IF $EXTRACT(X)="~"
Begin DoDot:2
+13 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")
+14 SET ^TMP("ORT",$JOB,X3,X2,ORIPS)=X
End DoDot:2
QUIT
+15 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
+16 SET ORII=""
+17 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
+18 SET ORIPS=0
FOR
SET ORIPS=$ORDER(^TMP("ORT",$JOB,ORII,ORKK,ORIPS))
if (ORIPS'>0)
QUIT
SET ORX0=^(ORIPS)
SET AFND=0
Begin DoDot:2
+19 IF $EXTRACT(ORX0)="~"
Begin DoDot:3
+20 ; mwa needed for FNDDRG^ORWDXC in ACHK
SET ORPSPKG=$PIECE($PIECE(ORX0,U,2),";",2)
+21 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
+22 SET ORORD=$PIECE($PIECE(ORX0,U,9),";")
DO ACHK
if 'AFND
QUIT
+23 ;Station ID
SET ^TMP("ORDATA",$JOB,ORIPSS,"WP",1)="1^"_ORSITE
+24 ;Medication Name
SET ^TMP("ORDATA",$JOB,ORIPSS,"WP",2)="2^"_$PIECE(ORX0,U,3)
+25 ;Status
SET ^TMP("ORDATA",$JOB,ORIPSS,"WP",3)="3^"_$PIECE(ORX0,U,10)
+26 ;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")
+27 ;Type: RX or NonVA Med
SET X=$PIECE(ORX0,"^")
SET ^TMP("ORDATA",$JOB,ORIPSS,"WP",5)="5^"_$SELECT(X="~NV":"NonVAMed",1:"RX")
+28 ;Start Date
SET ^TMP("ORDATA",$JOB,ORIPSS,"WP",6)="6^"_$$DATE^ORDVU($PIECE(ORX0,U,16))
+29 ;Stop Date
SET ^TMP("ORDATA",$JOB,ORIPSS,"WP",7)="7^"_$$DATE^ORDVU($PIECE(ORX0,U,5))
+30 ;Last Fill Date
SET ^TMP("ORDATA",$JOB,ORIPSS,"WP",8)="8^"_$$DATE^ORDVU($PIECE(ORX0,U,11))
+31 ;Provider
SET ^TMP("ORDATA",$JOB,ORIPSS,"WP",9)="9^"_$PIECE(ORX0,U,18)
+32 ;flag for detail
SET ^TMP("ORDATA",$JOB,ORIPSS,"WP",12)="12^[+]"
+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
ACHK ; Order check for drug allergies
+1 NEW ORIDA,ORORI,ORPXI,ILST,ORKDD,ORPSA,ORII,ORX
+2 if '$DATA(^OR(100,ORORD,.1))
QUIT
+3 SET ILST=1
+4 DO FNDDRG^ORWDXC(.ORX,+ORORD,ORPSPKG)
+5 SET ORII=""
FOR
SET ORII=$ORDER(ORX(ORII))
if 'ORII
QUIT
Begin DoDot:1
+6 NEW NPTR,LPTR,HL7,OI
+7 SET OI=$PIECE(ORX(ORII),"|")
+8 SET HL7=$PIECE(ORX(ORII),"|",3)
+9 SET NPTR=$PIECE(HL7,U)
+10 SET LPTR=$PIECE(HL7,U,4)
+11 IF '$LENGTH($GET(LPTR))
Begin DoDot:2
+12 DO OI2DD(.ORPSA,OI,ORPSPKG)
+13 SET ORKDD=""
FOR
SET ORKDD=$ORDER(ORPSA(ORKDD))
if 'ORKDD
QUIT
Begin DoDot:3
+14 SET NPTR=$PIECE(ORKDD,";",2)
+15 SET LPTR=+ORKDD
+16 SET AFND=$$ORCHK2^GMRAOR(DFN,"DR",$GET(NPTR)_$SELECT($GET(NPTR)'[".":".",1:"")_"."_LPTR,"","ORALL")
+17 IF AFND
DO ADETAIL
End DoDot:3
End DoDot:2
QUIT
+18 ; ICR 2378
SET AFND=$$ORCHK2^GMRAOR(DFN,"DR",$GET(NPTR)_$SELECT($GET(NPTR)'[".":".",1:"")_"."_LPTR,"","ORALL")
+19 IF AFND
DO ADETAIL
End DoDot:1
+20 QUIT
ADETAIL ;
+1 ; Set detail lines from ORALL array
+2 NEW ADA,ASDA,ASEVDA
+3 SET ^TMP("ORDATA",$JOB,ORIPSS,"WP",11,$$NXT)="11^"
+4 FOR ADA=1:1:ORALL
IF $DATA(ORALL(ADA,"MESSAGE"))
Begin DoDot:1
+5 SET ^TMP("ORDATA",$JOB,ORIPSS,"WP",11,$$NXT)="11^ Causative agent: "_$P(ORALL(ADA,"MESSAGE",2),"^",2)
+6 SET ^TMP("ORDATA",$JOB,ORIPSS,"WP",11,$$NXT)="11^"
+7 SET ^TMP("ORDATA",$JOB,ORIPSS,"WP",11,$$NXT)="11^ Symptons: "_$P(ORALL(ADA,"MESSAGE",2),"^",1)
+8 SET ^TMP("ORDATA",$JOB,ORIPSS,"WP",11,$$NXT)="11^ Drug Class: "_$G(ORALL(ADA,"MESSAGE","OFFENDERS","CLS"))
+9 SET ^TMP("ORDATA",$JOB,ORIPSS,"WP",11,$$NXT)="11^"
+10 SET ASDA=""
FOR
SET ASDA=$ORDER(ORALL(ADA,"MESSAGE",1,ASDA))
if ASDA=""
QUIT
IF $DATA(ORALL(ADA,"MESSAGE",1,ASDA))
Begin DoDot:2
+11 SET ^TMP("ORDATA",$JOB,ORIPSS,"WP",11,$$NXT)="11^ Originator: "_$P(ORALL(ADA,"MESSAGE",1,ASDA),"^",1)
+12 SET ^TMP("ORDATA",$JOB,ORIPSS,"WP",11,$$NXT)="11^ Originated: "_$P(ORALL(ADA,"MESSAGE",1,ASDA),"^",3)
+13 SET ^TMP("ORDATA",$JOB,ORIPSS,"WP",11,$$NXT)="11^Observed/Historical: "_$P(ORALL(ADA,"MESSAGE",1,ASDA),"^",4)
+14 IF $DATA(ORALL(ADA,"MESSAGE",1,ASDA,1))
SET ASEVDA=""
FOR
SET ASEVDA=$ORDER(ORALL(ADA,"MESSAGE",1,ASDA,1,ASEVDA))
if ASEVDA=""
QUIT
IF $DATA(ORALL(ADA,"MESSAGE",1,ASDA,1,ASEVDA))
Begin DoDot:3
+15 SET ^TMP("ORDATA",$JOB,ORIPSS,"WP",11,$$NXT)="11^ Obs Dates/Severity: "_$P(ORALL(ADA,"MESSAGE",1,ASDA,1,ASEVDA),"^",1)_" - "_$PIECE(ORALL(ADA,"MESSAGE",1,ASDA,1,ASEVDA),"^",2)
End DoDot:3
End DoDot:2
+16 SET ^TMP("ORDATA",$JOB,ORIPSS,"WP",11,$$NXT)="11^"
+17 SET ^TMP("ORDATA",$JOB,ORIPSS,"WP",11,$$NXT)="11^-------------------------------------------------------"
+18 SET ^TMP("ORDATA",$JOB,ORIPSS,"WP",11,$$NXT)="11^"
End DoDot:1
+19 QUIT
OI2DD(ORPSA,OROI,ORPSPKG) ;
+1 NEW PSOI
+2 if '$DATA(^ORD(101.43,OROI,0))
QUIT
+3 SET PSOI=$PIECE($PIECE(^ORD(101.43,OROI,0),U,2),";")
+4 if +$GET(PSOI)<1
QUIT
+5 DO DRG^PSSUTIL1(.ORPSA,PSOI,ORPSPKG)
+6 QUIT
