ORAMX ;POR/RSF - ADDITIONAL ANTICOAGULATION CALLS ;11/10/14 10:28
;;3.0;ORDER ENTRY/RESULTS REPORTING;**307,339,361,391**;Dec 17, 1997;Build 11
;;Per VHA Directive 2004-038, this routine should not be modified
Q
;
; External References:
; $$EXTERNAL^DILFD ICR #2055
; $$ICDDATA^ICDXCODE ICR #5699
; $$DATA2PCE^PXAPI ICR #1889
; $$FMTE/$$NOW^XLFDT ICR #10103
; $$LOW/$$UP^XLFSTR ICR #10104
;
COMPRPT ; Complications Report [ORAM COMPLICATIONS REPORT]
N DIRUT,ORAMSDT,ORAMEDT,ORAMSD,ORAMED,ORAMM,ORAMDL,ORAMT,ORAFMT,ORAMDFN,ORAMCNT,ORAMARR,ORAMINCM,ORAMSORT
S (ORAMED,ORAMSD)="",ORAMINCM=1
W !!,"Anticoagulation Complications Report",!
F D Q:+ORAMED>+ORAMSD!+$G(DIRUT)
. S ORAMSD=+$$READ("DA^::E"," Please Enter START Date: ","T-90","Enter a start date for the report")
. Q:'ORAMSD
. S ORAMED=+$$READ("DA^::E"," Please Enter END Date: ","T","Enter an INCLUSIVE end date for the report")
. Q:'ORAMED
. I $L(ORAMED,".")=1 S ORAMED=ORAMED_".2359"
. I ORAMSD>ORAMED W !,"END DATE must be more recent than the START DATE" S (ORAMSD,ORAMED)=""
Q:$S(ORAMSD'>0:1,ORAMED'>0:1,1:0)
S ORAMSDT=$$FMTE^XLFDT(ORAMSD,2),ORAMEDT=$$FMTE^XLFDT(ORAMED,2)
W ! S ORAFMT=$$READ("SA^r:Report;e:Export to Spreadsheet"," Please Specify Format: ","Report")
Q:+$G(DIRUT)
S:"Ee"[$P(ORAFMT,U) ORAMDL=1 S:"Rr"[$P(ORAFMT,U) ORAMDL=0
W ! S ORAMSORT=$$READ("SA^c:Clinic;d:Division"," Sort/Tally By: ","Clinic")
Q:+$G(DIRUT)
S ORAMSORT=$P(ORAMSORT,U)
W ! S ORAMINCM=+$$READ("YA","Include Minor Complications? ","YES")
Q:+$G(DIRUT)
S (ORAMCNT,ORAMDFN)=0
F S ORAMDFN=$O(^ORAM(103,ORAMDFN)) Q:'$G(ORAMDFN) D
. N ORAMFS S ORAMFS=" "
. F S ORAMFS=$O(^ORAM(103,ORAMDFN,3,ORAMFS),-1) Q:'+$G(ORAMFS) D
.. N ORAMCP
.. I $P(^ORAM(103,ORAMDFN,3,ORAMFS,0),U)<ORAMSD Q
.. I $P(^ORAM(103,ORAMDFN,3,ORAMFS,0),U)>ORAMED Q
.. S ORAMCP=$P(^ORAM(103,ORAMDFN,3,ORAMFS,0),U,2)
.. I +$G(ORAMCP) D
... N ORAMLOC,ORAMM,ORAMCLNO,ORAMCLNM,ORAMDIVN,ORAMDIV
... I (+ORAMINCM'>0),(ORAMCP>2) Q
... S ORAMCLNO=+$P($G(^ORAM(103,ORAMDFN,6)),U,2)
... I ORAMCLNO>0 D
.... S ORAMDIVN=+$P($G(^SC(ORAMCLNO,0)),U,15)
.... S ORAMCLNM=$$EXTERNAL^DILFD(103,101,"",ORAMCLNO) S:$G(ORAMCLNM)="" ORAMCLNM="CLINIC UNKNOWN"
.... S ORAMDIV=$$EXTERNAL^DILFD(44,3.5,"",ORAMDIVN) S:$G(ORAMDIV)="" ORAMDIV="DIVISION UNKNOWN"
... E S ORAMCLNM="CLINIC UNKNOWN",ORAMDIV="DIVISION UNKNOWN"
... S ORAMLOC=$S(ORAMSORT="c":ORAMCLNM,1:ORAMDIV)
... S ORAMARR(ORAMLOC,0)=$G(ORAMARR(ORAMLOC,0))+1
... S ORAMM=$E($P(^DPT($G(ORAMDFN),0),U),1,10)_" ("_$E($P(^(0),U,9),6,9)_")"
... I ORAMCP=1!(+ORAMINCM&(ORAMCP=3)) D
.... S ORAMARR(ORAMLOC,"B",0)=$G(ORAMARR(ORAMLOC,"B",0))+1
.... S ORAMARR(ORAMLOC,"B",ORAMDFN,$P(^ORAM(103,ORAMDFN,3,ORAMFS,0),U)_ORAMFS,1)=ORAMM_": INR Draw date - "_$$FMTE^XLFDT($P(^ORAM(103,ORAMDFN,3,ORAMFS,0),U),"2P")
.... N ORAMJ S ORAMJ=0
.... F S ORAMJ=$O(^ORAM(103,ORAMDFN,3,ORAMFS,2,ORAMJ)) Q:+ORAMJ'>0 D
..... N ORAMCMPL,ORAMFS0
..... S ORAMFS0=$G(^ORAM(103,ORAMDFN,3,ORAMFS,0))
..... S ORAMCMPL=$G(^ORAM(103,ORAMDFN,3,ORAMFS,2,ORAMJ,0))
..... S:$L(ORAMCMPL,":")>1 ORAMCMPL=$S($P(ORAMCMPL,":")="MB":"Major Bleed: ",$P(ORAMCMPL,":")="C":" ",1:ORAMCMPL)_$P(ORAMCMPL,":",2)
..... S ORAMARR(ORAMLOC,"B",ORAMDFN,$P(ORAMFS0,U)_ORAMFS,1_"."_ORAMJ)=$S(ORAMJ=1:"Complication date: ",1:"")_ORAMCMPL
..... S ORAMARR(ORAMLOC,"BX",ORAMDFN,$P(ORAMFS0,U)_ORAMFS,99)=$TR(ORAMLOC,";",",")_";"_$S(ORAMCP=3:"Minor Bleed",1:"Hemorrhagic")_";"_ORAMM_";"_$$FMTE^XLFDT($P(ORAMFS0,U),"2P")_";"
..... S ORAMARR(ORAMLOC,"BX",ORAMDFN,$P(ORAMFS0,U)_ORAMFS,99)=ORAMARR(ORAMLOC,"BX",ORAMDFN,$P(ORAMFS0,U)_ORAMFS,99)_$G(^ORAM(103,ORAMDFN,3,ORAMFS,2,1,0))
... I ORAMCP=2 D
.... S ORAMARR(ORAMLOC,"C",0)=$G(ORAMARR(ORAMLOC,"C",0))+1
.... S ORAMARR(ORAMLOC,"C",ORAMDFN,$P(^ORAM(103,ORAMDFN,3,ORAMFS,0),U)_ORAMFS,1)=ORAMM_": INR Draw date - "_$$FMTE^XLFDT($P(^ORAM(103,ORAMDFN,3,ORAMFS,0),U),"2P")
.... N ORAMJ S ORAMJ=0
.... F S ORAMJ=$O(^ORAM(103,ORAMDFN,3,ORAMFS,2,ORAMJ)) Q:'+$G(ORAMJ) D
..... N ORAMCMPL,ORAMFS0
..... S ORAMFS0=$G(^ORAM(103,ORAMDFN,3,ORAMFS,0))
..... S ORAMCMPL=^ORAM(103,ORAMDFN,3,ORAMFS,2,ORAMJ,0)
..... S:$L(ORAMCMPL,":")>1 ORAMCMPL=$S($P(ORAMCMPL,":")="MB":"Major Bleed: ",$P(ORAMCMPL,":")="C":" ",1:ORAMCMPL)_$P(ORAMCMPL,":",2)
..... S ORAMARR(ORAMLOC,"C",ORAMDFN,$P(ORAMFS0,U)_ORAMFS,1_"."_ORAMJ)=$S(ORAMJ=1:"Complication date: ",1:"")_ORAMCMPL
..... S ORAMARR(ORAMLOC,"CX",ORAMDFN,$P(ORAMFS0,U)_ORAMFS,99)=$TR(ORAMLOC,";",",")_";Thrombotic;"_ORAMM_";"_$$FMTE^XLFDT($P(ORAMFS0,U),"2P")_";"_$G(^ORAM(103,ORAMDFN,3,ORAMFS,2,1,0))
I ORAMDL=0 D COMP0(.ORAMARR,ORAMSDT,ORAMEDT,ORAMINCM)
I ORAMDL=1 D COMP1(.ORAMARR,ORAMSDT,ORAMEDT,ORAMINCM,ORAMSORT)
Q
COMP0(ORAMARR,ORAMSDT,ORAMEDT,ORAMINCM) ; Print Report Format
N OCLINIC
W @IOF,"COMPLICATIONS REPORT - ANTICOAGULATION: ",ORAMSDT," - ",ORAMEDT,!,$S('ORAMINCM:" (** EXCLUDING MINOR COMPLICATIONS **)"_$C(13)_$C(10),1:"")
I '$D(ORAMARR) W !,?5,"No Complications Noted." Q
S OCLINIC=""
F S OCLINIC=$O(ORAMARR(OCLINIC)) Q:OCLINIC']"" D
. W !!,?5,OCLINIC,": Total Complications - ",ORAMARR(OCLINIC,0)
. I $G(ORAMARR(OCLINIC,"B",0))>0 D ;BLEEDS FOR THIS CLINIC
.. N ODFN
.. W !!,?7," Bleeds (",ORAMARR(OCLINIC,"B",0),")",!
.. W !,?7," Details:"
.. S ODFN=0 F S ODFN=$O(ORAMARR(OCLINIC,"B",ODFN)) Q:+ODFN'>0 D
... N OCDATE S OCDATE=0
... F S OCDATE=$O(ORAMARR(OCLINIC,"B",ODFN,OCDATE)) Q:+OCDATE'>0 D
.... N OCNT S OCNT=0 W !
.... F S OCNT=$O(ORAMARR(OCLINIC,"B",ODFN,OCDATE,OCNT)) Q:+OCNT'>0 D
..... W !,?8,ORAMARR(OCLINIC,"B",ODFN,OCDATE,OCNT)
. I $G(ORAMARR(OCLINIC,"C",0))>0 D ;CLOTS FOR THIS CLINIC
.. N ODFN
.. W !!,?7," Clots (",ORAMARR(OCLINIC,"C",0),")",!
.. W !,?7," Details:"
.. S ODFN=0 F S ODFN=$O(ORAMARR(OCLINIC,"C",ODFN)) Q:+ODFN'>0 D
... N OCDATE S OCDATE=0
... F S OCDATE=$O(ORAMARR(OCLINIC,"C",ODFN,OCDATE)) Q:+OCDATE'>0 D
.... N OCNT S OCNT=0 W !
.... F S OCNT=$O(ORAMARR(OCLINIC,"C",ODFN,OCDATE,OCNT)) Q:+OCNT'>0 D
..... W !,?8,ORAMARR(OCLINIC,"C",ODFN,OCDATE,OCNT)
Q
COMP1(ORAMARR,ORAMSDT,ORAMEDT,ORAMINCM,ORAMSORT) ; Print Export Format
N OCLINIC
W @IOF,"COMPLICATIONS REPORT - ANTICOAGULATION: ",ORAMSDT," - ",ORAMEDT,!,$S('ORAMINCM:" (** EXCLUDING MINOR COMPLICATIONS **)"_$C(13)_$C(10),1:"")
I '$D(ORAMARR) W !,?5,"No Complications Noted." Q
W !,$S(ORAMSORT="c":"Clinic",1:"Division"),";Event;Patient;INR Draw Date;Complication Date"
S OCLINIC="" F S OCLINIC=$O(ORAMARR(OCLINIC)) Q:OCLINIC']"" D
. I $D(ORAMARR(OCLINIC,"BX")) D ;BLEEDS FOR THIS CLINIC
.. N ODFN S ODFN=0 F S ODFN=$O(ORAMARR(OCLINIC,"BX",ODFN)) Q:'+$G(ODFN) D
... N OCDATE S OCDATE=0 F S OCDATE=$O(ORAMARR(OCLINIC,"BX",ODFN,OCDATE)) Q:'+$G(OCDATE) D
.... W !,ORAMARR(OCLINIC,"BX",ODFN,OCDATE,99)
. I $D(ORAMARR(OCLINIC,"CX")) D ;CLOTS FOR THIS CLINIC
.. N ODFN S ODFN=0 F S ODFN=$O(ORAMARR(OCLINIC,"CX",ODFN)) Q:'+$G(ODFN) D
... N OCDATE S OCDATE=0 F S OCDATE=$O(ORAMARR(OCLINIC,"CX",ODFN,OCDATE)) Q:'+$G(OCDATE) D
.... W !,ORAMARR(OCLINIC,"CX",ODFN,OCDATE,99)
Q
;
CONSULT(RESULT,ORAMDFN,ORAMCNM) ; Called from RPC=ORAMX CONSULT
I '+$G(ORAMDFN) S RESULT(0)=0 Q
I $G(ORAMCNM)="" S RESULT(0)=0 Q
N ORAMCLST S ORAMCLST(0)=0
D RPCLIST^GMRCTIU(.ORAMCLST,ORAMDFN)
Q:ORAMCLST(0)=0 ;SHOULD BE NUMBER IN THE ARRAY
I ORAMCLST(0)>0 D
. N ORAMC S ORAMC=0 F S ORAMC=$O(ORAMCLST(ORAMC)) Q:'+$G(ORAMC) D
.. Q:ORAMCNM'=$P(ORAMCLST(ORAMC),U,3)
.. N ORAMK,ORAMCSTS
.. S ORAMK=0,ORAMCSTS=$P(ORAMCLST(ORAMC),U,5)
.. I $S(ORAMCSTS="PENDING":1,ORAMCSTS="ACTIVE":1,ORAMCSTS="SCHEDULED":1,1:0) S ORAMK=1
.. Q:'+ORAMK
.. N ORAMD S ORAMD=$$FMTE^XLFDT($P(ORAMCLST(ORAMC),U,2),"2P")
.. S RESULT(ORAMC)=ORAMD_": "_$P(ORAMCLST(ORAMC),U,3)_" ^"_$P(ORAMCLST(ORAMC),U,1)
Q
PCESET(RESULT,ORAMDFN,ORAMD1,ORAMSC44,ORAMEDT,ORAMSVC,ORAMNARR,ORAMPDX,ORAMSDX) ; RPC to file PCE Data
; RPC = ORAMX PCESET
; ORAMDFN = Pt. ID
; ORAMD1 = Data string e.g., 1143~27898|300|99363|427.31|^SC~0^IR~0^EC~1^MST~0^HNC~1^SHAD~0
; ORAMSC44 = Hosp Loc IEN
; ORAMEDT = Enc Dt/Tm
; ORAMSVC = Svc Cat (e.g., "A"mb or "T"elecomm)
; ORAMNARR = Prov Narr
; ORAMPDX = Auto Pri Indic
; ORAMSDX = Auto Sec Indic
;
I '+$G(ORAMDFN) S RESULT=99 Q
I '+$G(ORAMSC44) S RESULT=99 Q
I $G(ORAMD1)']"" S RESULT=99 Q
N ORAMNOW,ORAMDAY S ORAMNOW=$$NOW^XLFDT
S RESULT=0,ORAMEDT=$G(ORAMEDT,ORAMNOW),ORAMDAY=$P(ORAMEDT,"."),ORAMSVC=$G(ORAMSVC,"A")
I $G(ORAMD1)'="" D
. N ORAMPPR,ORAMSPR,ORAMCPT,ORAMSC,ORAMQ,ORAMVST,ERRARR,ERRPROB,ORAMPDXN,ORAMDXC,ORDXI
. S ORAMPPR=$P($P(ORAMD1,"|"),"~"),ORAMSPR=$P($P(ORAMD1,"|"),"~",2),ORAMSC=$P(ORAMD1,"|",2),ORAMCPT=$P(ORAMD1,"|",3),ORAMQ=$P(ORAMD1,"|",5)
. S ORAMDXC=$P(ORAMD1,"|",4)
. I $P($G(ORAMPDX),U)]"" D
.. N ORAMPDXC,ORAMPDXT,ORDXINC
.. S ORAMPDXC=$P(ORAMPDX,U),ORAMPDXT=$P(ORAMPDX,U,2),ORDXINC=1
.. I (ORAMPDXC]""),(ORAMPDXC'[".") S ORAMPDXC=ORAMPDXC_"."
.. S ORAMPDXN=+$$ICDDATA^ICDXCODE("DIAGNOSIS",ORAMPDXC,ORAMEDT,"E")
.. Q:+ORAMPDXN'>0
.. S ^TMP("ORAMPCE",$J,"DX/PL",1,"DIAGNOSIS")=$G(ORAMPDXN)
.. S ^TMP("ORAMPCE",$J,"DX/PL",1,"PRIMARY")="P"
.. S:ORAMPDXT]"" ^TMP("ORAMPCE",$J,"DX/PL",1,"NARRATIVE")=ORAMPDXT
.. I $P($G(ORAMSDX),U)]"" D
... N ORAMSDXC,ORAMSDXT,ORAMSDXN
... S ORAMSDXC=$P(ORAMSDX,U),ORAMSDXT=$P(ORAMSDX,U,2),ORDXINC=2
... I (ORAMSDXC]""),(ORAMSDXC'[".") S ORAMSDXC=ORAMSDXC_"."
... S ORAMSDXN=+$$ICDDATA^ICDXCODE("DIAGNOSIS",ORAMSDXC,ORAMEDT,"E")
... Q:+ORAMSDXN'>0
... S ^TMP("ORAMPCE",$J,"DX/PL",2,"DIAGNOSIS")=$G(ORAMSDXN)
... S ^TMP("ORAMPCE",$J,"DX/PL",2,"PRIMARY")="S"
... S:ORAMSDXT]"" ^TMP("ORAMPCE",$J,"DX/PL",2,"NARRATIVE")=ORAMSDXT
.. Q:+ORAMDXC']""
.. F ORDXI=1:1:$L(ORAMDXC,"/") D
... N ORDXC,ORDX S ORDXC=$P(ORAMDXC,"/",ORDXI)
... I (ORDXC]""),(ORDXC'[".") S ORDXC=ORDXC_"."
... S ORDX=+$$ICDDATA^ICDXCODE("DIAGNOSIS",ORDXC,ORAMEDT,"E")
... I +ORDX'>0 Q
... S ^TMP("ORAMPCE",$J,"DX/PL",ORDXI+ORDXINC,"DIAGNOSIS")=$G(ORDX)
... S ^TMP("ORAMPCE",$J,"DX/PL",ORDXI+ORDXINC,"PRIMARY")="S"
... S:$G(ORAMNARR)]"" ^TMP("ORAMPCE",$J,"DX/PL",ORDXI+ORDXINC,"NARRATIVE")=ORAMNARR
. E D
.. Q:+ORAMDXC']""
.. F ORDXI=1:1:$L(ORAMDXC,"/") D
... N ORDXC,ORDX S ORDXC=$P(ORAMDXC,"/",ORDXI)
... I (ORDXC]""),(ORDXC'[".") S ORDXC=ORDXC_"."
... S ORDX=+$$ICDDATA^ICDXCODE("DIAGNOSIS",ORDXC,ORAMEDT,"E")
... I +ORDX'>0 Q
... S:ORDXI=1 ORAMPDXN=ORDX
... S ^TMP("ORAMPCE",$J,"DX/PL",ORDXI,"DIAGNOSIS")=$G(ORDX)
... S ^TMP("ORAMPCE",$J,"DX/PL",ORDXI,"PRIMARY")=$S(ORDXI=1:"P",1:"S")
... S:$G(ORAMNARR)]"" ^TMP("ORAMPCE",$J,"DX/PL",ORDXI,"NARRATIVE")=ORAMNARR
. S ^TMP("ORAMPCE",$J,"ENCOUNTER",1,"DSS ID")=$G(ORAMSC) ;STOP CODE 40.7
. S ^TMP("ORAMPCE",$J,"ENCOUNTER",1,"ENC D/T")=ORAMEDT
. S ^TMP("ORAMPCE",$J,"ENCOUNTER",1,"HOS LOC")=ORAMSC44 ;9727 ;8005
. S ^TMP("ORAMPCE",$J,"ENCOUNTER",1,"PATIENT")=ORAMDFN
. S ^TMP("ORAMPCE",$J,"ENCOUNTER",1,"ENCOUNTER TYPE")="P" ;PRIMARY OR ANCILLARY
. S ^TMP("ORAMPCE",$J,"ENCOUNTER",1,"SERVICE CATEGORY")=ORAMSVC
. S ^TMP("ORAMPCE",$J,"ENCOUNTER",1,"CHECKOUT D/T")=$$NOW^XLFDT
. S ^TMP("ORAMPCE",$J,"PROCEDURE",1,"PROCEDURE")=$G(ORAMCPT)
. S:+ORAMPDXN>0 ^TMP("ORAMPCE",$J,"PROCEDURE",1,"DIAGNOSIS")=ORAMPDXN
. S ^TMP("ORAMPCE",$J,"PROCEDURE",1,"EVENT D/T")=ORAMEDT
. S ^TMP("ORAMPCE",$J,"PROCEDURE",1,"QTY")=1
. S:ORAMPPR]"" ^TMP("ORAMPCE",$J,"PROCEDURE",1,"ENC PROVIDER")=ORAMPPR ;FILE 200
. S ^TMP("ORAMPCE",$J,"PROCEDURE",1,"DEPARTMENT")=$G(ORAMSC) ;STOP CODE 40.7
. S ^TMP("ORAMPCE",$J,"PROVIDER",1,"NAME")=ORAMPPR
. S:ORAMPPR]"" ^TMP("ORAMPCE",$J,"PROVIDER",1,"PRIMARY")=1
. ; If Secondary Provider is passed, include them
. I ORAMSPR]"" D
. . S ^TMP("ORAMPCE",$J,"PROVIDER",2,"NAME")=ORAMSPR
. . S ^TMP("ORAMPCE",$J,"PROVIDER",2,"PRIMARY")=0
. ;comes in like: ^SC~0^IR~0^EC~1^MST~0
. S ^TMP("ORAMPCE",$J,"ENCOUNTER",1,"SC")=""
. S ^TMP("ORAMPCE",$J,"ENCOUNTER",1,"AO")=""
. S ^TMP("ORAMPCE",$J,"ENCOUNTER",1,"IR")=""
. S ^TMP("ORAMPCE",$J,"ENCOUNTER",1,"EC")=""
. S ^TMP("ORAMPCE",$J,"ENCOUNTER",1,"MST")=""
. S ^TMP("ORAMPCE",$J,"ENCOUNTER",1,"HNC")=""
. S ^TMP("ORAMPCE",$J,"ENCOUNTER",1,"CV")=""
. S ^TMP("ORAMPCE",$J,"ENCOUNTER",1,"SHAD")=""
. N ORAMCNT,I S ORAMCNT=$L(ORAMQ,U)
. I +$G(ORAMCNT) F I=2:1:ORAMCNT D
.. N T S T=$P(ORAMQ,U,I) Q:$G(T)=""
.. I $P(T,"~",1)'="" S ^TMP("ORAMPCE",$J,"ENCOUNTER",1,$P(T,"~",1))=$P(T,"~",2)
. S RESULT=$$DATA2PCE^PXAPI("^TMP(""ORAMPCE"",$J)","ORAM","ORAM ANTICOAGULATION MANAGEMENT PROGRAM",.ORAMVST,DUZ,,.ERRARR,,.ERRPROB)
Q
READ(TYPE,PROMPT,DEFAULT,HELP,SCREEN) ; Calls reader, returns response
N DIR,X,Y
S DIR(0)=TYPE
I $D(SCREEN) S DIR("S")=SCREEN
I $G(PROMPT)]"" S DIR("A")=PROMPT
I $G(DEFAULT)]"" S DIR("B")=DEFAULT
I $D(HELP) S DIR("?")=HELP
D ^DIR
I $G(X)="@" S Y="@" G READX
I Y]"",($L($G(Y),U)'=2) S Y=Y_U_$G(Y(0),Y)
READX Q Y
NAME(X,FMT) ; Call with X="LAST,FIRST MI", FMT=Return Format ("LAST, FI")
N ORLAST,ORLI,ORFIRST,ORFI,ORMI,ORI
I X']"" S FMT="" G NAMEX
I $S('$D(FMT):1,'$L(FMT):1,1:0) S FMT="LAST,FIRST"
S FMT=$$LOW^XLFSTR(FMT)
S ORLAST=$P(X,","),ORLI=$E(ORLAST),ORFIRST=$P(X,",",2)
S ORFI=$E(ORFIRST)
S ORMI=$S($P(ORFIRST," ",2)'="NMI":$E($P(ORFIRST," ",2)),1:"")
S ORFIRST=$P(ORFIRST," ")
F ORI="last","li","first","fi","mi" I FMT[ORI S FMT=$P(FMT,ORI)_@("OR"_$$UP^XLFSTR(ORI))_$P(FMT,ORI,2)
NAMEX Q FMT
PATIENT() ; Select a patient
N X,DIC,Y
S DIC=2,DIC(0)="AEMQ" D ^DIC
Q Y
VALIDORD(ORDA) ; Screen Orderable for INR
N ORDNM,ORY,ORDGDA,ORID S ORDNM="",ORY=0
; if orderable item inactive, exclude it
I +$G(^ORD(101.43,+ORDA,.1))>0 G VOX
; if display group is not LABORATORY, exclude it
S ORDGDA=$P($G(^ORD(101.43,+ORDA,0)),U,5)
I $S(+ORDGDA'>0:1,$P($G(^ORD(100.98,+ORDGDA,0)),U)'="LABORATORY":1,1:0) G VOX
; if ID not valid, exclude it
S ORID=+$P($G(^ORD(101.43,+ORDA,0)),U,2)
I '$$VALIDLAB(ORID) G VOX
; otherwise, allow selection
S ORY=1
VOX Q ORY
VALIDLAB(ORID) ; Is lab test valid?
N ORY S ORY=0
I $S(+ORID'>0:1,'$D(^LAB(60,+ORID,0)):1,1:0) G VLX
; if entry in LABORATORY TEST file (#60) doesn't have a LOCATION (DATA NAME), exclude it
I '$L($P($G(^LAB(60,+ORID,0)),U,5)) G VLX
; otherwise, allow selection
S ORY=1
VLX Q ORY
TEAMLIST(ORLIST) ; Team List Reports
N DIC,DHD,FLDS,L,FR,BY,TO,ORCL,ORPAR,ORALIST,ORCLIST
S DIC="^OR(100.21,",L=0,FLDS="[ORAM TEAM LIST]",BY="[ORAM TEAM LIST]"
W !!,"List of ",$S(ORLIST="A":"ALL",1:"COMPLEX")," Anticoagulation Patients for a Clinic",!
S ORCL=$$SELLOC^ORAMSET
I +ORCL'>0 D Q
. W $C(7),!!,"You must select a Clinic to proceed...",!
D GET^ORAMSET(.ORPAR,ORCL)
S ORALIST=$P($G(ORPAR(0)),U,2),ORCLIST=$P($G(ORPAR(0)),U,3)
S:+ORALIST ORALIST=$P($G(^OR(100.21,ORALIST,0)),U)
S:+ORCLIST ORCLIST=$P($G(^OR(100.21,ORCLIST,0)),U)
S (FR,TO,DHD)=$S(ORLIST="A":ORALIST,1:ORCLIST)
I FR']"" D Q
. W !,"You must define a list for ",$S(ORLIST="A":"ALL",1:"COMPLEX")," Anticoagulation Patients."
. W $$READ("EA","Press Return to Continue...")
D EN1^DIP
Q
NEXTLAB ; Next Lab Report
N DIC,DHD,FLDS,L,FR,BY,TO,ORCL,OREDT,ORLDT
S DIC="^ORAM(103,",L=0,FLDS="[ORAM TEAM LIST]",BY="@CLINIC,NEXT LAB,@PATIENT",(OREDT,ORLDT)=""
W !!,"List Anticoagulation Patients with Pending Lab Draws",!
S ORCL=$$SELLOC^ORAMSET
I +ORCL'>0 D Q
. W $C(7),!!,"You must select a Clinic to proceed...",!
S ORCL=$P($G(^SC(+ORCL,0)),U)
F D Q:+ORLDT>+OREDT!$D(DIRUT)
. S OREDT=+$$READ("DA^::E","Please Enter START Date: ","T","Enter a start date for the report")
. Q:'OREDT
. S ORLDT=+$$READ("DA^::E"," Please Enter END Date: ","T+14","Enter an INCLUSIVE end date for the report")
. Q:'ORLDT
. I $L(ORLDT,".")=1 S ORLDT=ORLDT_".2359"
. I OREDT>ORLDT W !,"END DATE must be more recent than the START DATE" S (OREDT,ORLDT)=""
Q:$S(OREDT'>0:1,ORLDT'>0:1,1:0)
S OREDT=$$FMTE^XLFDT(OREDT,2),ORLDT=$$FMTE^XLFDT(ORLDT,2)
S DHD=ORCL_" Next Lab Report"
S FR=ORCL_","_OREDT,TO=ORCL_","_ORLDT
D EN1^DIP
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORAMX 16077 printed Jan 18, 2025@03:28:19 Page 2
ORAMX ;POR/RSF - ADDITIONAL ANTICOAGULATION CALLS ;11/10/14 10:28
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**307,339,361,391**;Dec 17, 1997;Build 11
+2 ;;Per VHA Directive 2004-038, this routine should not be modified
+3 QUIT
+4 ;
+5 ; External References:
+6 ; $$EXTERNAL^DILFD ICR #2055
+7 ; $$ICDDATA^ICDXCODE ICR #5699
+8 ; $$DATA2PCE^PXAPI ICR #1889
+9 ; $$FMTE/$$NOW^XLFDT ICR #10103
+10 ; $$LOW/$$UP^XLFSTR ICR #10104
+11 ;
COMPRPT ; Complications Report [ORAM COMPLICATIONS REPORT]
+1 NEW DIRUT,ORAMSDT,ORAMEDT,ORAMSD,ORAMED,ORAMM,ORAMDL,ORAMT,ORAFMT,ORAMDFN,ORAMCNT,ORAMARR,ORAMINCM,ORAMSORT
+2 SET (ORAMED,ORAMSD)=""
SET ORAMINCM=1
+3 WRITE !!,"Anticoagulation Complications Report",!
+4 FOR
Begin DoDot:1
+5 SET ORAMSD=+$$READ("DA^::E"," Please Enter START Date: ","T-90","Enter a start date for the report")
+6 if 'ORAMSD
QUIT
+7 SET ORAMED=+$$READ("DA^::E"," Please Enter END Date: ","T","Enter an INCLUSIVE end date for the report")
+8 if 'ORAMED
QUIT
+9 IF $LENGTH(ORAMED,".")=1
SET ORAMED=ORAMED_".2359"
+10 IF ORAMSD>ORAMED
WRITE !,"END DATE must be more recent than the START DATE"
SET (ORAMSD,ORAMED)=""
End DoDot:1
if +ORAMED>+ORAMSD!+$GET(DIRUT)
QUIT
+11 if $SELECT(ORAMSD'>0
QUIT
+12 SET ORAMSDT=$$FMTE^XLFDT(ORAMSD,2)
SET ORAMEDT=$$FMTE^XLFDT(ORAMED,2)
+13 WRITE !
SET ORAFMT=$$READ("SA^r:Report;e:Export to Spreadsheet"," Please Specify Format: ","Report")
+14 if +$GET(DIRUT)
QUIT
+15 if "Ee"[$PIECE(ORAFMT,U)
SET ORAMDL=1
if "Rr"[$PIECE(ORAFMT,U)
SET ORAMDL=0
+16 WRITE !
SET ORAMSORT=$$READ("SA^c:Clinic;d:Division"," Sort/Tally By: ","Clinic")
+17 if +$GET(DIRUT)
QUIT
+18 SET ORAMSORT=$PIECE(ORAMSORT,U)
+19 WRITE !
SET ORAMINCM=+$$READ("YA","Include Minor Complications? ","YES")
+20 if +$GET(DIRUT)
QUIT
+21 SET (ORAMCNT,ORAMDFN)=0
+22 FOR
SET ORAMDFN=$ORDER(^ORAM(103,ORAMDFN))
if '$GET(ORAMDFN)
QUIT
Begin DoDot:1
+23 NEW ORAMFS
SET ORAMFS=" "
+24 FOR
SET ORAMFS=$ORDER(^ORAM(103,ORAMDFN,3,ORAMFS),-1)
if '+$GET(ORAMFS)
QUIT
Begin DoDot:2
+25 NEW ORAMCP
+26 IF $PIECE(^ORAM(103,ORAMDFN,3,ORAMFS,0),U)<ORAMSD
QUIT
+27 IF $PIECE(^ORAM(103,ORAMDFN,3,ORAMFS,0),U)>ORAMED
QUIT
+28 SET ORAMCP=$PIECE(^ORAM(103,ORAMDFN,3,ORAMFS,0),U,2)
+29 IF +$GET(ORAMCP)
Begin DoDot:3
+30 NEW ORAMLOC,ORAMM,ORAMCLNO,ORAMCLNM,ORAMDIVN,ORAMDIV
+31 IF (+ORAMINCM'>0)
IF (ORAMCP>2)
QUIT
+32 SET ORAMCLNO=+$PIECE($GET(^ORAM(103,ORAMDFN,6)),U,2)
+33 IF ORAMCLNO>0
Begin DoDot:4
+34 SET ORAMDIVN=+$PIECE($GET(^SC(ORAMCLNO,0)),U,15)
+35 SET ORAMCLNM=$$EXTERNAL^DILFD(103,101,"",ORAMCLNO)
if $GET(ORAMCLNM)=""
SET ORAMCLNM="CLINIC UNKNOWN"
+36 SET ORAMDIV=$$EXTERNAL^DILFD(44,3.5,"",ORAMDIVN)
if $GET(ORAMDIV)=""
SET ORAMDIV="DIVISION UNKNOWN"
End DoDot:4
+37 IF '$TEST
SET ORAMCLNM="CLINIC UNKNOWN"
SET ORAMDIV="DIVISION UNKNOWN"
+38 SET ORAMLOC=$SELECT(ORAMSORT="c":ORAMCLNM,1:ORAMDIV)
+39 SET ORAMARR(ORAMLOC,0)=$GET(ORAMARR(ORAMLOC,0))+1
+40 SET ORAMM=$EXTRACT($PIECE(^DPT($GET(ORAMDFN),0),U),1,10)_" ("_$EXTRACT($PIECE(^(0),U,9),6,9)_")"
+41 IF ORAMCP=1!(+ORAMINCM&(ORAMCP=3))
Begin DoDot:4
+42 SET ORAMARR(ORAMLOC,"B",0)=$GET(ORAMARR(ORAMLOC,"B",0))+1
+43 SET ORAMARR(ORAMLOC,"B",ORAMDFN,$PIECE(^ORAM(103,ORAMDFN,3,ORAMFS,0),U)_ORAMFS,1)=ORAMM_": INR Draw date - "_$$FMTE^XLFDT($PIECE(^ORAM(103,ORAMDFN,3,ORAMFS,0),U),"2P")
+44 NEW ORAMJ
SET ORAMJ=0
+45 FOR
SET ORAMJ=$ORDER(^ORAM(103,ORAMDFN,3,ORAMFS,2,ORAMJ))
if +ORAMJ'>0
QUIT
Begin DoDot:5
+46 NEW ORAMCMPL,ORAMFS0
+47 SET ORAMFS0=$GET(^ORAM(103,ORAMDFN,3,ORAMFS,0))
+48 SET ORAMCMPL=$GET(^ORAM(103,ORAMDFN,3,ORAMFS,2,ORAMJ,0))
+49 if $LENGTH(ORAMCMPL,"
SET ORAMCMPL=$SELECT($PIECE(ORAMCMPL,":")="MB":"Major Bleed: ",$PIECE(ORAMCMPL,":")="C":" ",1:ORAMCMPL)_$PIECE(ORAMCMPL,":",2)
+50 SET ORAMARR(ORAMLOC,"B",ORAMDFN,$PIECE(ORAMFS0,U)_ORAMFS,1_"."_ORAMJ)=$SELECT(ORAMJ=1:"Complication date: ",1:"")_ORAMCMPL
+51 SET ORAMARR(ORAMLOC,"BX",ORAMDFN,$PIECE(ORAMFS0,U)_ORAMFS,99)=$TRANSLATE(ORAMLOC,";",",")_";"_$SELECT(ORAMCP=3:"Minor Bleed",1:"Hemorrhagic")_";"_ORAMM_";"_$$FMTE^XLFDT($PIECE(ORAMFS0,U),"2P")_";"
+52 SET ORAMARR(ORAMLOC,"BX",ORAMDFN,$PIECE(ORAMFS0,U)_ORAMFS,99)=ORAMARR(ORAMLOC,"BX",ORAMDFN,$PIECE(ORAMFS0,U)_ORAMFS,99)_$GET(^ORAM(103,ORAMDFN,3,ORAMFS,2,1,0))
End DoDot:5
End DoDot:4
+53 IF ORAMCP=2
Begin DoDot:4
+54 SET ORAMARR(ORAMLOC,"C",0)=$GET(ORAMARR(ORAMLOC,"C",0))+1
+55 SET ORAMARR(ORAMLOC,"C",ORAMDFN,$PIECE(^ORAM(103,ORAMDFN,3,ORAMFS,0),U)_ORAMFS,1)=ORAMM_": INR Draw date - "_$$FMTE^XLFDT($PIECE(^ORAM(103,ORAMDFN,3,ORAMFS,0),U),"2P")
+56 NEW ORAMJ
SET ORAMJ=0
+57 FOR
SET ORAMJ=$ORDER(^ORAM(103,ORAMDFN,3,ORAMFS,2,ORAMJ))
if '+$GET(ORAMJ)
QUIT
Begin DoDot:5
+58 NEW ORAMCMPL,ORAMFS0
+59 SET ORAMFS0=$GET(^ORAM(103,ORAMDFN,3,ORAMFS,0))
+60 SET ORAMCMPL=^ORAM(103,ORAMDFN,3,ORAMFS,2,ORAMJ,0)
+61 if $LENGTH(ORAMCMPL,"
SET ORAMCMPL=$SELECT($PIECE(ORAMCMPL,":")="MB":"Major Bleed: ",$PIECE(ORAMCMPL,":")="C":" ",1:ORAMCMPL)_$PIECE(ORAMCMPL,":",2)
+62 SET ORAMARR(ORAMLOC,"C",ORAMDFN,$PIECE(ORAMFS0,U)_ORAMFS,1_"."_ORAMJ)=$SELECT(ORAMJ=1:"Complication date: ",1:"")_ORAMCMPL
+63 SET ORAMARR(ORAMLOC,"CX",ORAMDFN,$PIECE(ORAMFS0,U)_ORAMFS,99)=$TRANSLATE(ORAMLOC,";",",")_";Thrombotic;"_ORAMM_";"_$$FMTE^XLFDT($PIECE(ORAMFS0,U),"2P")_";"_$GET(^ORAM(103,ORAMDFN,3,ORAMFS,2,1,0))
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+64 IF ORAMDL=0
DO COMP0(.ORAMARR,ORAMSDT,ORAMEDT,ORAMINCM)
+65 IF ORAMDL=1
DO COMP1(.ORAMARR,ORAMSDT,ORAMEDT,ORAMINCM,ORAMSORT)
+66 QUIT
COMP0(ORAMARR,ORAMSDT,ORAMEDT,ORAMINCM) ; Print Report Format
+1 NEW OCLINIC
+2 WRITE @IOF,"COMPLICATIONS REPORT - ANTICOAGULATION: ",ORAMSDT," - ",ORAMEDT,!,$SELECT('ORAMINCM:" (** EXCLUDING MINOR COMPLICATIONS **)"_$CHAR(13)_$CHAR(10),1:"")
+3 IF '$DATA(ORAMARR)
WRITE !,?5,"No Complications Noted."
QUIT
+4 SET OCLINIC=""
+5 FOR
SET OCLINIC=$ORDER(ORAMARR(OCLINIC))
if OCLINIC']""
QUIT
Begin DoDot:1
+6 WRITE !!,?5,OCLINIC,": Total Complications - ",ORAMARR(OCLINIC,0)
+7 ;BLEEDS FOR THIS CLINIC
IF $GET(ORAMARR(OCLINIC,"B",0))>0
Begin DoDot:2
+8 NEW ODFN
+9 WRITE !!,?7," Bleeds (",ORAMARR(OCLINIC,"B",0),")",!
+10 WRITE !,?7," Details:"
+11 SET ODFN=0
FOR
SET ODFN=$ORDER(ORAMARR(OCLINIC,"B",ODFN))
if +ODFN'>0
QUIT
Begin DoDot:3
+12 NEW OCDATE
SET OCDATE=0
+13 FOR
SET OCDATE=$ORDER(ORAMARR(OCLINIC,"B",ODFN,OCDATE))
if +OCDATE'>0
QUIT
Begin DoDot:4
+14 NEW OCNT
SET OCNT=0
WRITE !
+15 FOR
SET OCNT=$ORDER(ORAMARR(OCLINIC,"B",ODFN,OCDATE,OCNT))
if +OCNT'>0
QUIT
Begin DoDot:5
+16 WRITE !,?8,ORAMARR(OCLINIC,"B",ODFN,OCDATE,OCNT)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
+17 ;CLOTS FOR THIS CLINIC
IF $GET(ORAMARR(OCLINIC,"C",0))>0
Begin DoDot:2
+18 NEW ODFN
+19 WRITE !!,?7," Clots (",ORAMARR(OCLINIC,"C",0),")",!
+20 WRITE !,?7," Details:"
+21 SET ODFN=0
FOR
SET ODFN=$ORDER(ORAMARR(OCLINIC,"C",ODFN))
if +ODFN'>0
QUIT
Begin DoDot:3
+22 NEW OCDATE
SET OCDATE=0
+23 FOR
SET OCDATE=$ORDER(ORAMARR(OCLINIC,"C",ODFN,OCDATE))
if +OCDATE'>0
QUIT
Begin DoDot:4
+24 NEW OCNT
SET OCNT=0
WRITE !
+25 FOR
SET OCNT=$ORDER(ORAMARR(OCLINIC,"C",ODFN,OCDATE,OCNT))
if +OCNT'>0
QUIT
Begin DoDot:5
+26 WRITE !,?8,ORAMARR(OCLINIC,"C",ODFN,OCDATE,OCNT)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+27 QUIT
COMP1(ORAMARR,ORAMSDT,ORAMEDT,ORAMINCM,ORAMSORT) ; Print Export Format
+1 NEW OCLINIC
+2 WRITE @IOF,"COMPLICATIONS REPORT - ANTICOAGULATION: ",ORAMSDT," - ",ORAMEDT,!,$SELECT('ORAMINCM:" (** EXCLUDING MINOR COMPLICATIONS **)"_$CHAR(13)_$CHAR(10),1:"")
+3 IF '$DATA(ORAMARR)
WRITE !,?5,"No Complications Noted."
QUIT
+4 WRITE !,$SELECT(ORAMSORT="c":"Clinic",1:"Division"),";Event;Patient;INR Draw Date;Complication Date"
+5 SET OCLINIC=""
FOR
SET OCLINIC=$ORDER(ORAMARR(OCLINIC))
if OCLINIC']""
QUIT
Begin DoDot:1
+6 ;BLEEDS FOR THIS CLINIC
IF $DATA(ORAMARR(OCLINIC,"BX"))
Begin DoDot:2
+7 NEW ODFN
SET ODFN=0
FOR
SET ODFN=$ORDER(ORAMARR(OCLINIC,"BX",ODFN))
if '+$GET(ODFN)
QUIT
Begin DoDot:3
+8 NEW OCDATE
SET OCDATE=0
FOR
SET OCDATE=$ORDER(ORAMARR(OCLINIC,"BX",ODFN,OCDATE))
if '+$GET(OCDATE)
QUIT
Begin DoDot:4
+9 WRITE !,ORAMARR(OCLINIC,"BX",ODFN,OCDATE,99)
End DoDot:4
End DoDot:3
End DoDot:2
+10 ;CLOTS FOR THIS CLINIC
IF $DATA(ORAMARR(OCLINIC,"CX"))
Begin DoDot:2
+11 NEW ODFN
SET ODFN=0
FOR
SET ODFN=$ORDER(ORAMARR(OCLINIC,"CX",ODFN))
if '+$GET(ODFN)
QUIT
Begin DoDot:3
+12 NEW OCDATE
SET OCDATE=0
FOR
SET OCDATE=$ORDER(ORAMARR(OCLINIC,"CX",ODFN,OCDATE))
if '+$GET(OCDATE)
QUIT
Begin DoDot:4
+13 WRITE !,ORAMARR(OCLINIC,"CX",ODFN,OCDATE,99)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
CONSULT(RESULT,ORAMDFN,ORAMCNM) ; Called from RPC=ORAMX CONSULT
+1 IF '+$GET(ORAMDFN)
SET RESULT(0)=0
QUIT
+2 IF $GET(ORAMCNM)=""
SET RESULT(0)=0
QUIT
+3 NEW ORAMCLST
SET ORAMCLST(0)=0
+4 DO RPCLIST^GMRCTIU(.ORAMCLST,ORAMDFN)
+5 ;SHOULD BE NUMBER IN THE ARRAY
if ORAMCLST(0)=0
QUIT
+6 IF ORAMCLST(0)>0
Begin DoDot:1
+7 NEW ORAMC
SET ORAMC=0
FOR
SET ORAMC=$ORDER(ORAMCLST(ORAMC))
if '+$GET(ORAMC)
QUIT
Begin DoDot:2
+8 if ORAMCNM'=$PIECE(ORAMCLST(ORAMC),U,3)
QUIT
+9 NEW ORAMK,ORAMCSTS
+10 SET ORAMK=0
SET ORAMCSTS=$PIECE(ORAMCLST(ORAMC),U,5)
+11 IF $SELECT(ORAMCSTS="PENDING":1,ORAMCSTS="ACTIVE":1,ORAMCSTS="SCHEDULED":1,1:0)
SET ORAMK=1
+12 if '+ORAMK
QUIT
+13 NEW ORAMD
SET ORAMD=$$FMTE^XLFDT($PIECE(ORAMCLST(ORAMC),U,2),"2P")
+14 SET RESULT(ORAMC)=ORAMD_": "_$PIECE(ORAMCLST(ORAMC),U,3)_" ^"_$PIECE(ORAMCLST(ORAMC),U,1)
End DoDot:2
End DoDot:1
+15 QUIT
PCESET(RESULT,ORAMDFN,ORAMD1,ORAMSC44,ORAMEDT,ORAMSVC,ORAMNARR,ORAMPDX,ORAMSDX) ; RPC to file PCE Data
+1 ; RPC = ORAMX PCESET
+2 ; ORAMDFN = Pt. ID
+3 ; ORAMD1 = Data string e.g., 1143~27898|300|99363|427.31|^SC~0^IR~0^EC~1^MST~0^HNC~1^SHAD~0
+4 ; ORAMSC44 = Hosp Loc IEN
+5 ; ORAMEDT = Enc Dt/Tm
+6 ; ORAMSVC = Svc Cat (e.g., "A"mb or "T"elecomm)
+7 ; ORAMNARR = Prov Narr
+8 ; ORAMPDX = Auto Pri Indic
+9 ; ORAMSDX = Auto Sec Indic
+10 ;
+11 IF '+$GET(ORAMDFN)
SET RESULT=99
QUIT
+12 IF '+$GET(ORAMSC44)
SET RESULT=99
QUIT
+13 IF $GET(ORAMD1)']""
SET RESULT=99
QUIT
+14 NEW ORAMNOW,ORAMDAY
SET ORAMNOW=$$NOW^XLFDT
+15 SET RESULT=0
SET ORAMEDT=$GET(ORAMEDT,ORAMNOW)
SET ORAMDAY=$PIECE(ORAMEDT,".")
SET ORAMSVC=$GET(ORAMSVC,"A")
+16 IF $GET(ORAMD1)'=""
Begin DoDot:1
+17 NEW ORAMPPR,ORAMSPR,ORAMCPT,ORAMSC,ORAMQ,ORAMVST,ERRARR,ERRPROB,ORAMPDXN,ORAMDXC,ORDXI
+18 SET ORAMPPR=$PIECE($PIECE(ORAMD1,"|"),"~")
SET ORAMSPR=$PIECE($PIECE(ORAMD1,"|"),"~",2)
SET ORAMSC=$PIECE(ORAMD1,"|",2)
SET ORAMCPT=$PIECE(ORAMD1,"|",3)
SET ORAMQ=$PIECE(ORAMD1,"|",5)
+19 SET ORAMDXC=$PIECE(ORAMD1,"|",4)
+20 IF $PIECE($GET(ORAMPDX),U)]""
Begin DoDot:2
+21 NEW ORAMPDXC,ORAMPDXT,ORDXINC
+22 SET ORAMPDXC=$PIECE(ORAMPDX,U)
SET ORAMPDXT=$PIECE(ORAMPDX,U,2)
SET ORDXINC=1
+23 IF (ORAMPDXC]"")
IF (ORAMPDXC'[".")
SET ORAMPDXC=ORAMPDXC_"."
+24 SET ORAMPDXN=+$$ICDDATA^ICDXCODE("DIAGNOSIS",ORAMPDXC,ORAMEDT,"E")
+25 if +ORAMPDXN'>0
QUIT
+26 SET ^TMP("ORAMPCE",$JOB,"DX/PL",1,"DIAGNOSIS")=$GET(ORAMPDXN)
+27 SET ^TMP("ORAMPCE",$JOB,"DX/PL",1,"PRIMARY")="P"
+28 if ORAMPDXT]""
SET ^TMP("ORAMPCE",$JOB,"DX/PL",1,"NARRATIVE")=ORAMPDXT
+29 IF $PIECE($GET(ORAMSDX),U)]""
Begin DoDot:3
+30 NEW ORAMSDXC,ORAMSDXT,ORAMSDXN
+31 SET ORAMSDXC=$PIECE(ORAMSDX,U)
SET ORAMSDXT=$PIECE(ORAMSDX,U,2)
SET ORDXINC=2
+32 IF (ORAMSDXC]"")
IF (ORAMSDXC'[".")
SET ORAMSDXC=ORAMSDXC_"."
+33 SET ORAMSDXN=+$$ICDDATA^ICDXCODE("DIAGNOSIS",ORAMSDXC,ORAMEDT,"E")
+34 if +ORAMSDXN'>0
QUIT
+35 SET ^TMP("ORAMPCE",$JOB,"DX/PL",2,"DIAGNOSIS")=$GET(ORAMSDXN)
+36 SET ^TMP("ORAMPCE",$JOB,"DX/PL",2,"PRIMARY")="S"
+37 if ORAMSDXT]""
SET ^TMP("ORAMPCE",$JOB,"DX/PL",2,"NARRATIVE")=ORAMSDXT
End DoDot:3
+38 if +ORAMDXC']""
QUIT
+39 FOR ORDXI=1:1:$LENGTH(ORAMDXC,"/")
Begin DoDot:3
+40 NEW ORDXC,ORDX
SET ORDXC=$PIECE(ORAMDXC,"/",ORDXI)
+41 IF (ORDXC]"")
IF (ORDXC'[".")
SET ORDXC=ORDXC_"."
+42 SET ORDX=+$$ICDDATA^ICDXCODE("DIAGNOSIS",ORDXC,ORAMEDT,"E")
+43 IF +ORDX'>0
QUIT
+44 SET ^TMP("ORAMPCE",$JOB,"DX/PL",ORDXI+ORDXINC,"DIAGNOSIS")=$GET(ORDX)
+45 SET ^TMP("ORAMPCE",$JOB,"DX/PL",ORDXI+ORDXINC,"PRIMARY")="S"
+46 if $GET(ORAMNARR)]""
SET ^TMP("ORAMPCE",$JOB,"DX/PL",ORDXI+ORDXINC,"NARRATIVE")=ORAMNARR
End DoDot:3
End DoDot:2
+47 IF '$TEST
Begin DoDot:2
+48 if +ORAMDXC']""
QUIT
+49 FOR ORDXI=1:1:$LENGTH(ORAMDXC,"/")
Begin DoDot:3
+50 NEW ORDXC,ORDX
SET ORDXC=$PIECE(ORAMDXC,"/",ORDXI)
+51 IF (ORDXC]"")
IF (ORDXC'[".")
SET ORDXC=ORDXC_"."
+52 SET ORDX=+$$ICDDATA^ICDXCODE("DIAGNOSIS",ORDXC,ORAMEDT,"E")
+53 IF +ORDX'>0
QUIT
+54 if ORDXI=1
SET ORAMPDXN=ORDX
+55 SET ^TMP("ORAMPCE",$JOB,"DX/PL",ORDXI,"DIAGNOSIS")=$GET(ORDX)
+56 SET ^TMP("ORAMPCE",$JOB,"DX/PL",ORDXI,"PRIMARY")=$SELECT(ORDXI=1:"P",1:"S")
+57 if $GET(ORAMNARR)]""
SET ^TMP("ORAMPCE",$JOB,"DX/PL",ORDXI,"NARRATIVE")=ORAMNARR
End DoDot:3
End DoDot:2
+58 ;STOP CODE 40.7
SET ^TMP("ORAMPCE",$JOB,"ENCOUNTER",1,"DSS ID")=$GET(ORAMSC)
+59 SET ^TMP("ORAMPCE",$JOB,"ENCOUNTER",1,"ENC D/T")=ORAMEDT
+60 ;9727 ;8005
SET ^TMP("ORAMPCE",$JOB,"ENCOUNTER",1,"HOS LOC")=ORAMSC44
+61 SET ^TMP("ORAMPCE",$JOB,"ENCOUNTER",1,"PATIENT")=ORAMDFN
+62 ;PRIMARY OR ANCILLARY
SET ^TMP("ORAMPCE",$JOB,"ENCOUNTER",1,"ENCOUNTER TYPE")="P"
+63 SET ^TMP("ORAMPCE",$JOB,"ENCOUNTER",1,"SERVICE CATEGORY")=ORAMSVC
+64 SET ^TMP("ORAMPCE",$JOB,"ENCOUNTER",1,"CHECKOUT D/T")=$$NOW^XLFDT
+65 SET ^TMP("ORAMPCE",$JOB,"PROCEDURE",1,"PROCEDURE")=$GET(ORAMCPT)
+66 if +ORAMPDXN>0
SET ^TMP("ORAMPCE",$JOB,"PROCEDURE",1,"DIAGNOSIS")=ORAMPDXN
+67 SET ^TMP("ORAMPCE",$JOB,"PROCEDURE",1,"EVENT D/T")=ORAMEDT
+68 SET ^TMP("ORAMPCE",$JOB,"PROCEDURE",1,"QTY")=1
+69 ;FILE 200
if ORAMPPR]""
SET ^TMP("ORAMPCE",$JOB,"PROCEDURE",1,"ENC PROVIDER")=ORAMPPR
+70 ;STOP CODE 40.7
SET ^TMP("ORAMPCE",$JOB,"PROCEDURE",1,"DEPARTMENT")=$GET(ORAMSC)
+71 SET ^TMP("ORAMPCE",$JOB,"PROVIDER",1,"NAME")=ORAMPPR
+72 if ORAMPPR]""
SET ^TMP("ORAMPCE",$JOB,"PROVIDER",1,"PRIMARY")=1
+73 ; If Secondary Provider is passed, include them
+74 IF ORAMSPR]""
Begin DoDot:2
+75 SET ^TMP("ORAMPCE",$JOB,"PROVIDER",2,"NAME")=ORAMSPR
+76 SET ^TMP("ORAMPCE",$JOB,"PROVIDER",2,"PRIMARY")=0
End DoDot:2
+77 ;comes in like: ^SC~0^IR~0^EC~1^MST~0
+78 SET ^TMP("ORAMPCE",$JOB,"ENCOUNTER",1,"SC")=""
+79 SET ^TMP("ORAMPCE",$JOB,"ENCOUNTER",1,"AO")=""
+80 SET ^TMP("ORAMPCE",$JOB,"ENCOUNTER",1,"IR")=""
+81 SET ^TMP("ORAMPCE",$JOB,"ENCOUNTER",1,"EC")=""
+82 SET ^TMP("ORAMPCE",$JOB,"ENCOUNTER",1,"MST")=""
+83 SET ^TMP("ORAMPCE",$JOB,"ENCOUNTER",1,"HNC")=""
+84 SET ^TMP("ORAMPCE",$JOB,"ENCOUNTER",1,"CV")=""
+85 SET ^TMP("ORAMPCE",$JOB,"ENCOUNTER",1,"SHAD")=""
+86 NEW ORAMCNT,I
SET ORAMCNT=$LENGTH(ORAMQ,U)
+87 IF +$GET(ORAMCNT)
FOR I=2:1:ORAMCNT
Begin DoDot:2
+88 NEW T
SET T=$PIECE(ORAMQ,U,I)
if $GET(T)=""
QUIT
+89 IF $PIECE(T,"~",1)'=""
SET ^TMP("ORAMPCE",$JOB,"ENCOUNTER",1,$PIECE(T,"~",1))=$PIECE(T,"~",2)
End DoDot:2
+90 SET RESULT=$$DATA2PCE^PXAPI("^TMP(""ORAMPCE"",$J)","ORAM","ORAM ANTICOAGULATION MANAGEMENT PROGRAM",.ORAMVST,DUZ,,.ERRARR,,.ERRPROB)
End DoDot:1
+91 QUIT
READ(TYPE,PROMPT,DEFAULT,HELP,SCREEN) ; Calls reader, returns response
+1 NEW DIR,X,Y
+2 SET DIR(0)=TYPE
+3 IF $DATA(SCREEN)
SET DIR("S")=SCREEN
+4 IF $GET(PROMPT)]""
SET DIR("A")=PROMPT
+5 IF $GET(DEFAULT)]""
SET DIR("B")=DEFAULT
+6 IF $DATA(HELP)
SET DIR("?")=HELP
+7 DO ^DIR
+8 IF $GET(X)="@"
SET Y="@"
GOTO READX
+9 IF Y]""
IF ($LENGTH($GET(Y),U)'=2)
SET Y=Y_U_$GET(Y(0),Y)
READX QUIT Y
NAME(X,FMT) ; Call with X="LAST,FIRST MI", FMT=Return Format ("LAST, FI")
+1 NEW ORLAST,ORLI,ORFIRST,ORFI,ORMI,ORI
+2 IF X']""
SET FMT=""
GOTO NAMEX
+3 IF $SELECT('$DATA(FMT):1,'$LENGTH(FMT):1,1:0)
SET FMT="LAST,FIRST"
+4 SET FMT=$$LOW^XLFSTR(FMT)
+5 SET ORLAST=$PIECE(X,",")
SET ORLI=$EXTRACT(ORLAST)
SET ORFIRST=$PIECE(X,",",2)
+6 SET ORFI=$EXTRACT(ORFIRST)
+7 SET ORMI=$SELECT($PIECE(ORFIRST," ",2)'="NMI":$EXTRACT($PIECE(ORFIRST," ",2)),1:"")
+8 SET ORFIRST=$PIECE(ORFIRST," ")
+9 FOR ORI="last","li","first","fi","mi"
IF FMT[ORI
SET FMT=$PIECE(FMT,ORI)_@("OR"_$$UP^XLFSTR(ORI))_$PIECE(FMT,ORI,2)
NAMEX QUIT FMT
PATIENT() ; Select a patient
+1 NEW X,DIC,Y
+2 SET DIC=2
SET DIC(0)="AEMQ"
DO ^DIC
+3 QUIT Y
VALIDORD(ORDA) ; Screen Orderable for INR
+1 NEW ORDNM,ORY,ORDGDA,ORID
SET ORDNM=""
SET ORY=0
+2 ; if orderable item inactive, exclude it
+3 IF +$GET(^ORD(101.43,+ORDA,.1))>0
GOTO VOX
+4 ; if display group is not LABORATORY, exclude it
+5 SET ORDGDA=$PIECE($GET(^ORD(101.43,+ORDA,0)),U,5)
+6 IF $SELECT(+ORDGDA'>0:1,$PIECE($GET(^ORD(100.98,+ORDGDA,0)),U)'="LABORATORY":1,1:0)
GOTO VOX
+7 ; if ID not valid, exclude it
+8 SET ORID=+$PIECE($GET(^ORD(101.43,+ORDA,0)),U,2)
+9 IF '$$VALIDLAB(ORID)
GOTO VOX
+10 ; otherwise, allow selection
+11 SET ORY=1
VOX QUIT ORY
VALIDLAB(ORID) ; Is lab test valid?
+1 NEW ORY
SET ORY=0
+2 IF $SELECT(+ORID'>0:1,'$DATA(^LAB(60,+ORID,0)):1,1:0)
GOTO VLX
+3 ; if entry in LABORATORY TEST file (#60) doesn't have a LOCATION (DATA NAME), exclude it
+4 IF '$LENGTH($PIECE($GET(^LAB(60,+ORID,0)),U,5))
GOTO VLX
+5 ; otherwise, allow selection
+6 SET ORY=1
VLX QUIT ORY
TEAMLIST(ORLIST) ; Team List Reports
+1 NEW DIC,DHD,FLDS,L,FR,BY,TO,ORCL,ORPAR,ORALIST,ORCLIST
+2 SET DIC="^OR(100.21,"
SET L=0
SET FLDS="[ORAM TEAM LIST]"
SET BY="[ORAM TEAM LIST]"
+3 WRITE !!,"List of ",$SELECT(ORLIST="A":"ALL",1:"COMPLEX")," Anticoagulation Patients for a Clinic",!
+4 SET ORCL=$$SELLOC^ORAMSET
+5 IF +ORCL'>0
Begin DoDot:1
+6 WRITE $CHAR(7),!!,"You must select a Clinic to proceed...",!
End DoDot:1
QUIT
+7 DO GET^ORAMSET(.ORPAR,ORCL)
+8 SET ORALIST=$PIECE($GET(ORPAR(0)),U,2)
SET ORCLIST=$PIECE($GET(ORPAR(0)),U,3)
+9 if +ORALIST
SET ORALIST=$PIECE($GET(^OR(100.21,ORALIST,0)),U)
+10 if +ORCLIST
SET ORCLIST=$PIECE($GET(^OR(100.21,ORCLIST,0)),U)
+11 SET (FR,TO,DHD)=$SELECT(ORLIST="A":ORALIST,1:ORCLIST)
+12 IF FR']""
Begin DoDot:1
+13 WRITE !,"You must define a list for ",$SELECT(ORLIST="A":"ALL",1:"COMPLEX")," Anticoagulation Patients."
+14 WRITE $$READ("EA","Press Return to Continue...")
End DoDot:1
QUIT
+15 DO EN1^DIP
+16 QUIT
NEXTLAB ; Next Lab Report
+1 NEW DIC,DHD,FLDS,L,FR,BY,TO,ORCL,OREDT,ORLDT
+2 SET DIC="^ORAM(103,"
SET L=0
SET FLDS="[ORAM TEAM LIST]"
SET BY="@CLINIC,NEXT LAB,@PATIENT"
SET (OREDT,ORLDT)=""
+3 WRITE !!,"List Anticoagulation Patients with Pending Lab Draws",!
+4 SET ORCL=$$SELLOC^ORAMSET
+5 IF +ORCL'>0
Begin DoDot:1
+6 WRITE $CHAR(7),!!,"You must select a Clinic to proceed...",!
End DoDot:1
QUIT
+7 SET ORCL=$PIECE($GET(^SC(+ORCL,0)),U)
+8 FOR
Begin DoDot:1
+9 SET OREDT=+$$READ("DA^::E","Please Enter START Date: ","T","Enter a start date for the report")
+10 if 'OREDT
QUIT
+11 SET ORLDT=+$$READ("DA^::E"," Please Enter END Date: ","T+14","Enter an INCLUSIVE end date for the report")
+12 if 'ORLDT
QUIT
+13 IF $LENGTH(ORLDT,".")=1
SET ORLDT=ORLDT_".2359"
+14 IF OREDT>ORLDT
WRITE !,"END DATE must be more recent than the START DATE"
SET (OREDT,ORLDT)=""
End DoDot:1
if +ORLDT>+OREDT!$DATA(DIRUT)
QUIT
+15 if $SELECT(OREDT'>0
QUIT
+16 SET OREDT=$$FMTE^XLFDT(OREDT,2)
SET ORLDT=$$FMTE^XLFDT(ORLDT,2)
+17 SET DHD=ORCL_" Next Lab Report"
+18 SET FR=ORCL_","_OREDT
SET TO=ORCL_","_ORLDT
+19 DO EN1^DIP
+20 QUIT
