ORAMX1 ;ISL/JER - ADDITIONAL ANTICOAGULATION CALLS ;12/05/14 09:42
;;3.0;ORDER ENTRY/RESULTS REPORTING;**391**;Dec 17, 1997;Build 11
;;Per VHA Directive 2004-038, this routine should not be modified
Q
;
RPT(ROOT,DFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,MAX,ORFHIE) ; Generate report for CPRS
N ORAMCNT,ORAMJ,ORAMHCT,ORAMCLIN,ORAMPIND,ORAMSIND,ORAICODE,ORAINARR,ORAITXT,ORAIDESC,ORAIND,ORVDT,ORDXS,IMPLDT,CODSYS
I '$D(^ORAM(103,"B",DFN)) Q
W $P(^DPT(DFN,0),"^")," ",$E($P(^DPT(DFN,0),"^",9),1,3),"-",$E($P(^DPT(DFN,0),"^",9),4,5),"-",$E($P(^DPT(DFN,0),"^",9),6,9)
I $P(^ORAM(103,DFN,0),"^",10)=1 W !,?10,"******* COMPLEX PATIENT *******"
S ORAMCLIN=$P($G(^ORAM(103,DFN,6)),U,2),(ORAMPIND,ORAMSIND)=""
S ORVDT=$O(^ORAM(103,DFN,3,"B",""),-1)
I +ORVDT'>0 S ORVDT=DT
E D
. N ORDA,ORDFS0
. S ORDA=$O(^ORAM(103,DFN,3,"B",ORVDT,0)) Q:+ORDA'>0
. S ORDFS0=$G(^ORAM(103,DFN,3,ORDA,0))
. S:$P(ORDFS0,U,9)>0 ORVDT=$P(ORDFS0,U,9)
. D:+ORAMCLIN GETVSIT(.ORDXS,DFN,ORVDT,ORAMCLIN)
S IMPLDT=$$IMPDATE^LEXU("10D")
S CODSYS=$S(ORVDT<IMPLDT:"ICD-9-CM",1:"ICD-10-CM")
I +$G(ORDXS)'>0 D I 1
. N ICDCS
. I +ORAMCLIN D
.. N ICDC
.. I ORVDT<IMPLDT D I 1
... S ICDC=$$GET^XPAR(ORAMCLIN_";SC(","ORAM AUTO PRIMARY INDICATION",1,"E")
.. E D
... S ICDC=$$GET^XPAR(ORAMCLIN_";SC(","ORAM I10 AUTO PRIM INDICATION",1,"E")
.. I ICDC]"" D
... N ICDD,ICDDESC,ICDCS
... S ICDCS=$P($$CODECS^ICDEX(ICDC,80,ORVDT),U,2) S:ICDCS]"" CODSYS=ICDCS
... D ICDDESC^ICDXCODE("DIAGNOSIS",ICDC,ORVDT,.ICDDESC)
... S ORAMPIND=ICDC_U_$$TITLE^XLFSTR($G(ICDDESC(1)))_" ("_CODSYS_" "_ICDC_")"
.. S ICDC=""
.. I ORVDT<IMPLDT D I 1
... S ICDC=$$GET^XPAR(ORAMCLIN_";SC(","ORAM AUTO SECONDARY INDICATION",1,"E")
.. E D
... S ICDC=$$GET^XPAR(ORAMCLIN_";SC(","ORAM I10 AUTO SEC INDICATION",1,"E")
.. I ICDC]"" D
... N ICDD,ICDDESC,ICDCS
... S ICDCS=$P($$CODECS^ICDEX(ICDC,80,ORVDT),U,2) S:ICDCS]"" CODSYS=ICDCS
... D ICDDESC^ICDXCODE("DIAGNOSIS",ICDC,ORVDT,.ICDDESC)
... S ORAMSIND=ICDC_U_$$TITLE^XLFSTR($G(ICDDESC(1)))_" ("_CODSYS_" "_ICDC_")"
. S ORAITXT=$P($P(^ORAM(103,DFN,0),"^",3),"=")
. S ORAICODE=$P($P(^ORAM(103,DFN,0),"^",3),"=",2) S:ORAICODE'["." ORAICODE=ORAICODE_"."
. S ICDCS=$P($$CODECS^ICDEX(ORAICODE,80,ORVDT),U,2) S:ICDCS]"" CODSYS=ICDCS
. D ICDDESC^ICDXCODE("DIAGNOSIS",ORAICODE,ORVDT,.ORAIDESC)
. S ORAINARR=$$TITLE^XLFSTR($G(ORAIDESC(1)))
. S ORAIND=ORAICODE_U_$S($$UP^XLFSTR(ORAITXT)'=$$UP^XLFSTR(ORAINARR):ORAITXT_" - ",1:"")_ORAINARR_" ("_CODSYS_" "_ORAICODE_")"
. I ORAMPIND]"" D
.. N PIND,AIND,ORI
.. S PIND=$$WRAP($P(ORAMPIND,U,2),55)
.. W !!,"Primary Indication: ",$P(PIND,"|")
.. F ORI=2:1:$L(PIND,"|") W !?22,$P(PIND,"|",ORI)
.. I ORAMSIND]"" D
... N SIND,ORJ
... S SIND=$$WRAP($P(ORAMSIND,U,2),55)
... W !," Add'l Indications: ",$P(SIND,"|")
... F ORJ=2:1:$L(SIND,"|") W !?22,$P(SIND,"|",ORJ)
.. S AIND=$$WRAP($P(ORAIND,U,2),55)
.. W !,$S($D(ORAMSIND):" ",1:" Add'l Indication: "),$P(AIND,"|")
.. F ORI=2:1:$L(AIND,"|") W !?22,$P(AIND,"|",ORI)
. E D
.. N AIND,ORI
.. S AIND=$$WRAP($P(ORAIND,U,2),55)
.. W !!,"Primary Indication: ",$P(AIND,"|")
.. F ORI=2:1:$L(AIND,"|") W !?22,$P(AIND,"|",ORI)
E D
. N PIND,AIND,ORI,ORJ
. S PIND=$$WRAP($P(ORDXS(1),U,2),55)
. W !!,"Primary Indication: ",$P(PIND,"|")
. F ORI=2:1:$L(PIND,"|") W !?22,$P(PIND,"|",ORI)
. Q:ORDXS'>1
. S AIND=$$WRAP($P(ORDXS(2),U,2),55)
. W !?$S(ORDXS>2:1,1:2),"Add'l Indication",$S(ORDXS>2:"s",1:""),": ",$P(AIND,"|")
. F ORI=2:1:$L(AIND,"|") W !?22,$P(AIND,"|",ORI)
. F ORJ=3:1:ORDXS D
.. S AIND=$$WRAP($P(ORDXS(ORJ),U,2),55)
.. F ORI=1:1:$L(AIND,"|") W !?$S(ORI=1:20,1:22),$P(AIND,"|",ORI)
W !!," Goal INR: ",$P(^ORAM(103,DFN,0),"^",2)
D HCT^ORAM(.ORAMHCT,DFN)
I $L(ORAMHCT,U)>1 D I 1
. W !?10,"Last ",$S($$UP^XLFSTR($P(ORAMHCT,U,3))["HGB":"Hgb",$$UP^XLFSTR($P(ORAMHCT,U,3))["HEMOGLOBIN":"Hgb",1:"HCT"),": "
. W $S($P(ORAMHCT,U)]"":$P(ORAMHCT,U),1:"No result")," on ",$S($P(ORAMHCT,U,2)]"":$P(ORAMHCT,U,2),1:"file")
E W !!?10,ORAMHCT
I +$P($G(^ORAM(103,DFN,6)),U,5)!+$O(^ORAM(103,DFN,7,0)) D
. W !!,"Patient is Eligible for LMWH Bridging"
. I +$O(^ORAM(103,DFN,7,0)) D
.. N ORI S ORI=0
.. W ":"
.. F S ORI=$O(^ORAM(103,DFN,7,ORI)) Q:+ORI'>0 W !?2,$G(^ORAM(103,DFN,7,ORI,0))
. E W "."
I $P($G(^ORAM(103,DFN,1,0)),"^",3)>0 S ORAMCNT=$P(^ORAM(103,DFN,1,0),"^",3) D
. W !!,"Special Instructions:"
. F ORAMJ=1:1:ORAMCNT W !?2,^ORAM(103,DFN,1,ORAMJ,0)
I $P(^ORAM(103,DFN,0),"^",11)=2 W !?2,"Pt has given permission to leave anticoag msg on msg machine."
I $P($G(^ORAM(103,DFN,4,0)),"^",3)>0 S ORAMCNT=$P(^ORAM(103,DFN,4,0),"^",3) D
. W !?2,"OK to leave anticoagulation message with:"
. F ORAMJ=1:1:ORAMCNT W !?4,^ORAM(103,DFN,4,ORAMJ,0)
I $P($G(^ORAM(103,DFN,2,0)),"^",3)>0 S ORAMCNT=$P(^ORAM(103,DFN,2,0),"^",3) D
. W !!,"Secondary Indication(s)/Risk Factors:"
. F ORAMJ=1:1:ORAMCNT W !?2,^ORAM(103,DFN,2,ORAMJ,0)
W !
I $P(^ORAM(103,DFN,0),"^",5)'="" W !,"Start Date: ",$P(^ORAM(103,DFN,0),"^",5)
I $P(^ORAM(103,DFN,0),"^",7)'="" W ?35,"Duration: ",$P(^ORAM(103,DFN,0),"^",7)
W !,"==========================================================================="
W !,"DATE",?10,"INR",?18,"Notified",?30,"TWD",?36,"Comments:"
W !,"---------------------------------------------------------------------------"
I $D(^ORAM(103,DFN,3,"B")) D
. N ORAMFSD S ORAMFSD=" ",ORAMCNT=0
. F S ORAMFSD=$O(^ORAM(103,DFN,3,ORAMFSD),-1) Q:$G(ORAMFSD)<1 D
.. I $$DTCHK^ORAM2(DFN,ALPHA,OMEGA,ORAMFSD)=0 Q ;need to change this to the new date
.. N ORAMDD1,ORAMDOSE,ORAMPS,ORAMPNOT
.. I '+$D(^ORAM(103,DFN,3,ORAMFSD,"LOG",0)) W !,$$FMTE^XLFDT($E($P(^ORAM(103,DFN,3,ORAMFSD,0),"^",9),1,7),2) ;changed from $P(^ORAM(103,DFN,3,ORAMCNT,0),"^")
.. I +$D(^ORAM(103,DFN,3,ORAMFSD,"LOG",0)) S ORAMDD1=$P($P(^ORAM(103,DFN,3,ORAMFSD,"LOG",1,0),"(",2),".") Q:'+$G(ORAMDD1) W !,$$FMTE^XLFDT(ORAMDD1,2)
.. S ORAMPNOT=$$WRAP($P(^ORAM(103,DFN,3,ORAMFSD,0),"^",8),11)
.. W ?11,$P(^ORAM(103,DFN,3,ORAMFSD,0),"^",3) ;INR
.. W ?18,$P(ORAMPNOT,"|") ;Pt Notified
.. W ?30,$P(^ORAM(103,DFN,3,ORAMFSD,0),"^",6) ;TWD
.. ; Comments
.. I $P($G(^ORAM(103,DFN,3,ORAMFSD,1,0)),"^",3)>0 D I 1
... N ORAMCC,ORAMCLN S (ORAMCC,ORAMCLN)=0
... F S ORAMCLN=$O(^ORAM(103,DFN,3,ORAMFSD,1,ORAMCLN)) Q:+ORAMCLN'>0 D
.... I $P(^ORAM(103,DFN,3,ORAMFSD,0),"^",3)'="",ORAMCLN=2 W ?10,$$FMTE^XLFDT($P(^ORAM(103,DFN,3,ORAMFSD,0),"^"),2)
.... W:ORAMCLN>1 ?18,$P(ORAMPNOT,"|",ORAMCLN)
.... W ?38,^ORAM(103,DFN,3,ORAMFSD,1,ORAMCLN,0),!
.... S ORAMCC=ORAMCC+1
... I $L(ORAMPNOT,"|")>ORAMCC D
.... N ORAMI S ORAMI=0 F ORAMI=ORAMCC+1:1:$L(ORAMPNOT,"|") W ?18,$P(ORAMPNOT,"|",ORAMI),!
.. E D W !
... I $L(ORAMPNOT,"|")>1 D
.... N ORAMI S ORAMI=0 F ORAMI=2:1:$L(ORAMPNOT,"|") W ?18,$P(ORAMPNOT,"|",ORAMI),!
.. ; Patient Instructions
.. I +$O(^ORAM(103,DFN,3,ORAMFSD,3,0)) D
... N ORI S ORI=0
... W !,"Patient Instructions (from Letter):"
... F S ORI=$O(^ORAM(103,DFN,3,ORAMFSD,3,ORI)) Q:+ORI'>0 D
.... N ORPILN,ORJ S ORPILN=$G(^ORAM(103,DFN,3,ORAMFSD,3,ORI,0))
.... S:$L(ORPILN)>77 ORPILN=$$WRAP(ORPILN,77)
.... F ORJ=1:1:$L(ORPILN,"|") W !?2,$P(ORPILN,"|",ORJ)
... W !
.. ; Daily Dosing
.. S ORAMDOSE=$P(^ORAM(103,DFN,3,ORAMFSD,0),"^",7)
.. I $L(ORAMDOSE) D
... N ORAMTP,ORAMTM,ORI
... S ORAMPS=$P(^ORAM(103,DFN,3,ORAMFSD,0),"^",5),(ORAMTP,ORAMTM)=0
... W !,"Current Dosing (using ",ORAMPS," mg tab):",!
... W ?6,$J("Sun",6),?12,$J("Mon",6),?18,$J("Tue",6),?24,$J("Wed",6),?30,$J("Thu",6),?36,$J("Fri",6),?42,$J("Sat",6),?48,$J("Tot",6),!
... W "Tab" F ORI=1:1:$L(ORAMDOSE,"|") S ORAMTP=ORAMTP+($P(ORAMDOSE,"|",ORI)/ORAMPS) W ?(6*ORI),$J(($P(ORAMDOSE,"|",ORI)/ORAMPS),6)
... W ?48,$J(ORAMTP,6),!
... W "mgs" F ORI=1:1:$L(ORAMDOSE,"|") S ORAMTM=ORAMTM+$P(ORAMDOSE,"|",ORI) W ?(6*ORI),$J($P(ORAMDOSE,"|",ORI),6)
... W ?48,$J(ORAMTM,6),!
.. ; Complications
.. I +$P(^ORAM(103,DFN,3,ORAMFSD,0),"^",2) D
... N ORAMCTXT,ORAMCMPL
... S ORAMCTXT=$S($P(^ORAM(103,DFN,3,ORAMFSD,0),"^",2)=1:"Major Bleed ",$P(^(0),"^",2)=2:"Complication(s) ",$P(^(0),"^",2)=3:"Minor Bleed ",1:"")
... I $D(^ORAM(103,DFN,3,ORAMFSD,2)) N ORAMRSF S ORAMRSF=0 F S ORAMRSF=$O(^ORAM(103,DFN,3,ORAMFSD,2,ORAMRSF)) Q:ORAMRSF<1 D
.... N ORI
.... I ORAMRSF=1 W ?38,ORAMCTXT,"noted: (",^ORAM(103,DFN,3,ORAMFSD,2,ORAMRSF,0),")",! Q
.... S ORAMCMPL=^ORAM(103,DFN,3,ORAMFSD,2,ORAMRSF,0)
.... I $S(ORAMCMPL["MB:":1,ORAMCMPL["C:":1,1:0) S ORAMCMPL=$P(ORAMCMPL,":",2)
.... I $L(ORAMCMPL)>37 S ORAMCMPL=$$WRAP(ORAMCMPL,37)
.... F ORI=1:1:$L(ORAMCMPL,"|") W ?$S(ORI=1:38,1:40),$P(ORAMCMPL,"|",ORI),!
.. W ?38,"-------------------------------------",!
Q
;
WRAP(TEXT,LENGTH) ; Breaks text string into substrings of length LENGTH
N ORAMI,ORAMJ,LINE,ORAMX,ORAMX1,ORAMX2,ORAMY
I $G(TEXT)']"" Q ""
F ORAMI=1:1 D Q:ORAMI=$L(TEXT," ")
. S ORAMX=$P(TEXT," ",ORAMI)
. I $L(ORAMX)>LENGTH D
.. S ORAMX1=$E(ORAMX,1,LENGTH),ORAMX2=$E(ORAMX,LENGTH+1,$L(ORAMX))
.. S $P(TEXT," ",ORAMI)=ORAMX1_" "_ORAMX2
S LINE=1,ORAMX(1)=$P(TEXT," ")
F ORAMI=2:1 D Q:ORAMI'<$L(TEXT," ")
. S:$L($G(ORAMX(LINE))_" "_$P(TEXT," ",ORAMI))>LENGTH LINE=LINE+1,ORAMY=1
. S ORAMX(LINE)=$G(ORAMX(LINE))_$S(+$G(ORAMY):"",1:" ")_$P(TEXT," ",ORAMI),ORAMY=0
S ORAMJ=0,TEXT="" F ORAMI=1:1 S ORAMJ=$O(ORAMX(ORAMJ)) Q:+ORAMJ'>0 S TEXT=TEXT_$S(ORAMI=1:"",1:"|")_ORAMX(ORAMJ)
Q TEXT
;
GETVSIT(ORDXS,ORDFN,ORVDT,ORLOC) ; Find the Visit for a given Pt, Location, and Visit Date(/Time)
N ORVSIT,ORI
K ^TMP("PXKENC",$J)
S ORDXS=0
S ORVSIT=$$GETENC^PXAPI(ORDFN,ORVDT,ORLOC)
I +ORVSIT'>0 S ORDXS=ORDXS_"^No Visit Found" Q
I '$D(^TMP("PXKENC",$J,ORVSIT,"POV")) S ORDXS=ORDXS_"^No Dxs for Visit" Q
S ORI=0
F S ORI=$O(^TMP("PXKENC",$J,ORVSIT,"POV",ORI)) Q:+ORI'>0 D
. N ORPOV,ORDX,ORDXC,ORDXT
. S ORPOV=$G(^TMP("PXKENC",$J,ORVSIT,"POV",ORI,0))
. S ORDX=$P(ORPOV,U) Q:+ORDX'>0
. S ORDXC=$$CODEC^ICDEX(80,ORDX)
. S ORDXT=$$TITLE^XLFSTR($$VLTD^ICDEX(ORDX,ORVDT))
. S ORDXS=ORDXS+1
. S ORDXS(ORDXS)=ORDXC_U_$$SETNARR^ORWPCE3($P(ORPOV,U,4),ORDXC)
K ^TMP("PXKENC",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORAMX1 10157 printed Sep 23, 2025@20:03:27 Page 2
ORAMX1 ;ISL/JER - ADDITIONAL ANTICOAGULATION CALLS ;12/05/14 09:42
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**391**;Dec 17, 1997;Build 11
+2 ;;Per VHA Directive 2004-038, this routine should not be modified
+3 QUIT
+4 ;
RPT(ROOT,DFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,MAX,ORFHIE) ; Generate report for CPRS
+1 NEW ORAMCNT,ORAMJ,ORAMHCT,ORAMCLIN,ORAMPIND,ORAMSIND,ORAICODE,ORAINARR,ORAITXT,ORAIDESC,ORAIND,ORVDT,ORDXS,IMPLDT,CODSYS
+2 IF '$DATA(^ORAM(103,"B",DFN))
QUIT
+3 WRITE $PIECE(^DPT(DFN,0),"^")," ",$EXTRACT($PIECE(^DPT(DFN,0),"^",9),1,3),"-",$EXTRACT($PIECE(^DPT(DFN,0),"^",9),4,5),"-",$EXTRACT($PIECE(^DPT(DFN,0),"^",9),6,9)
+4 IF $PIECE(^ORAM(103,DFN,0),"^",10)=1
WRITE !,?10,"******* COMPLEX PATIENT *******"
+5 SET ORAMCLIN=$PIECE($GET(^ORAM(103,DFN,6)),U,2)
SET (ORAMPIND,ORAMSIND)=""
+6 SET ORVDT=$ORDER(^ORAM(103,DFN,3,"B",""),-1)
+7 IF +ORVDT'>0
SET ORVDT=DT
+8 IF '$TEST
Begin DoDot:1
+9 NEW ORDA,ORDFS0
+10 SET ORDA=$ORDER(^ORAM(103,DFN,3,"B",ORVDT,0))
if +ORDA'>0
QUIT
+11 SET ORDFS0=$GET(^ORAM(103,DFN,3,ORDA,0))
+12 if $PIECE(ORDFS0,U,9)>0
SET ORVDT=$PIECE(ORDFS0,U,9)
+13 if +ORAMCLIN
DO GETVSIT(.ORDXS,DFN,ORVDT,ORAMCLIN)
End DoDot:1
+14 SET IMPLDT=$$IMPDATE^LEXU("10D")
+15 SET CODSYS=$SELECT(ORVDT<IMPLDT:"ICD-9-CM",1:"ICD-10-CM")
+16 IF +$GET(ORDXS)'>0
Begin DoDot:1
+17 NEW ICDCS
+18 IF +ORAMCLIN
Begin DoDot:2
+19 NEW ICDC
+20 IF ORVDT<IMPLDT
Begin DoDot:3
+21 SET ICDC=$$GET^XPAR(ORAMCLIN_";SC(","ORAM AUTO PRIMARY INDICATION",1,"E")
End DoDot:3
IF 1
+22 IF '$TEST
Begin DoDot:3
+23 SET ICDC=$$GET^XPAR(ORAMCLIN_";SC(","ORAM I10 AUTO PRIM INDICATION",1,"E")
End DoDot:3
+24 IF ICDC]""
Begin DoDot:3
+25 NEW ICDD,ICDDESC,ICDCS
+26 SET ICDCS=$PIECE($$CODECS^ICDEX(ICDC,80,ORVDT),U,2)
if ICDCS]""
SET CODSYS=ICDCS
+27 DO ICDDESC^ICDXCODE("DIAGNOSIS",ICDC,ORVDT,.ICDDESC)
+28 SET ORAMPIND=ICDC_U_$$TITLE^XLFSTR($GET(ICDDESC(1)))_" ("_CODSYS_" "_ICDC_")"
End DoDot:3
+29 SET ICDC=""
+30 IF ORVDT<IMPLDT
Begin DoDot:3
+31 SET ICDC=$$GET^XPAR(ORAMCLIN_";SC(","ORAM AUTO SECONDARY INDICATION",1,"E")
End DoDot:3
IF 1
+32 IF '$TEST
Begin DoDot:3
+33 SET ICDC=$$GET^XPAR(ORAMCLIN_";SC(","ORAM I10 AUTO SEC INDICATION",1,"E")
End DoDot:3
+34 IF ICDC]""
Begin DoDot:3
+35 NEW ICDD,ICDDESC,ICDCS
+36 SET ICDCS=$PIECE($$CODECS^ICDEX(ICDC,80,ORVDT),U,2)
if ICDCS]""
SET CODSYS=ICDCS
+37 DO ICDDESC^ICDXCODE("DIAGNOSIS",ICDC,ORVDT,.ICDDESC)
+38 SET ORAMSIND=ICDC_U_$$TITLE^XLFSTR($GET(ICDDESC(1)))_" ("_CODSYS_" "_ICDC_")"
End DoDot:3
End DoDot:2
+39 SET ORAITXT=$PIECE($PIECE(^ORAM(103,DFN,0),"^",3),"=")
+40 SET ORAICODE=$PIECE($PIECE(^ORAM(103,DFN,0),"^",3),"=",2)
if ORAICODE'["."
SET ORAICODE=ORAICODE_"."
+41 SET ICDCS=$PIECE($$CODECS^ICDEX(ORAICODE,80,ORVDT),U,2)
if ICDCS]""
SET CODSYS=ICDCS
+42 DO ICDDESC^ICDXCODE("DIAGNOSIS",ORAICODE,ORVDT,.ORAIDESC)
+43 SET ORAINARR=$$TITLE^XLFSTR($GET(ORAIDESC(1)))
+44 SET ORAIND=ORAICODE_U_$SELECT($$UP^XLFSTR(ORAITXT)'=$$UP^XLFSTR(ORAINARR):ORAITXT_" - ",1:"")_ORAINARR_" ("_CODSYS_" "_ORAICODE_")"
+45 IF ORAMPIND]""
Begin DoDot:2
+46 NEW PIND,AIND,ORI
+47 SET PIND=$$WRAP($PIECE(ORAMPIND,U,2),55)
+48 WRITE !!,"Primary Indication: ",$PIECE(PIND,"|")
+49 FOR ORI=2:1:$LENGTH(PIND,"|")
WRITE !?22,$PIECE(PIND,"|",ORI)
+50 IF ORAMSIND]""
Begin DoDot:3
+51 NEW SIND,ORJ
+52 SET SIND=$$WRAP($PIECE(ORAMSIND,U,2),55)
+53 WRITE !," Add'l Indications: ",$PIECE(SIND,"|")
+54 FOR ORJ=2:1:$LENGTH(SIND,"|")
WRITE !?22,$PIECE(SIND,"|",ORJ)
End DoDot:3
+55 SET AIND=$$WRAP($PIECE(ORAIND,U,2),55)
+56 WRITE !,$SELECT($DATA(ORAMSIND):" ",1:" Add'l Indication: "),$PIECE(AIND,"|")
+57 FOR ORI=2:1:$LENGTH(AIND,"|")
WRITE !?22,$PIECE(AIND,"|",ORI)
End DoDot:2
+58 IF '$TEST
Begin DoDot:2
+59 NEW AIND,ORI
+60 SET AIND=$$WRAP($PIECE(ORAIND,U,2),55)
+61 WRITE !!,"Primary Indication: ",$PIECE(AIND,"|")
+62 FOR ORI=2:1:$LENGTH(AIND,"|")
WRITE !?22,$PIECE(AIND,"|",ORI)
End DoDot:2
End DoDot:1
IF 1
+63 IF '$TEST
Begin DoDot:1
+64 NEW PIND,AIND,ORI,ORJ
+65 SET PIND=$$WRAP($PIECE(ORDXS(1),U,2),55)
+66 WRITE !!,"Primary Indication: ",$PIECE(PIND,"|")
+67 FOR ORI=2:1:$LENGTH(PIND,"|")
WRITE !?22,$PIECE(PIND,"|",ORI)
+68 if ORDXS'>1
QUIT
+69 SET AIND=$$WRAP($PIECE(ORDXS(2),U,2),55)
+70 WRITE !?$SELECT(ORDXS>2:1,1:2),"Add'l Indication",$SELECT(ORDXS>2:"s",1:""),": ",$PIECE(AIND,"|")
+71 FOR ORI=2:1:$LENGTH(AIND,"|")
WRITE !?22,$PIECE(AIND,"|",ORI)
+72 FOR ORJ=3:1:ORDXS
Begin DoDot:2
+73 SET AIND=$$WRAP($PIECE(ORDXS(ORJ),U,2),55)
+74 FOR ORI=1:1:$LENGTH(AIND,"|")
WRITE !?$SELECT(ORI=1:20,1:22),$PIECE(AIND,"|",ORI)
End DoDot:2
End DoDot:1
+75 WRITE !!," Goal INR: ",$PIECE(^ORAM(103,DFN,0),"^",2)
+76 DO HCT^ORAM(.ORAMHCT,DFN)
+77 IF $LENGTH(ORAMHCT,U)>1
Begin DoDot:1
+78 WRITE !?10,"Last ",$SELECT($$UP^XLFSTR($PIECE(ORAMHCT,U,3))["HGB":"Hgb",$$UP^XLFSTR($PIECE(ORAMHCT,U,3))["HEMOGLOBIN":"Hgb",1:"HCT"),": "
+79 WRITE $SELECT($PIECE(ORAMHCT,U)]"":$PIECE(ORAMHCT,U),1:"No result")," on ",$SELECT($PIECE(ORAMHCT,U,2)]"":$PIECE(ORAMHCT,U,2),1:"file")
End DoDot:1
IF 1
+80 IF '$TEST
WRITE !!?10,ORAMHCT
+81 IF +$PIECE($GET(^ORAM(103,DFN,6)),U,5)!+$ORDER(^ORAM(103,DFN,7,0))
Begin DoDot:1
+82 WRITE !!,"Patient is Eligible for LMWH Bridging"
+83 IF +$ORDER(^ORAM(103,DFN,7,0))
Begin DoDot:2
+84 NEW ORI
SET ORI=0
+85 WRITE ":"
+86 FOR
SET ORI=$ORDER(^ORAM(103,DFN,7,ORI))
if +ORI'>0
QUIT
WRITE !?2,$GET(^ORAM(103,DFN,7,ORI,0))
End DoDot:2
+87 IF '$TEST
WRITE "."
End DoDot:1
+88 IF $PIECE($GET(^ORAM(103,DFN,1,0)),"^",3)>0
SET ORAMCNT=$PIECE(^ORAM(103,DFN,1,0),"^",3)
Begin DoDot:1
+89 WRITE !!,"Special Instructions:"
+90 FOR ORAMJ=1:1:ORAMCNT
WRITE !?2,^ORAM(103,DFN,1,ORAMJ,0)
End DoDot:1
+91 IF $PIECE(^ORAM(103,DFN,0),"^",11)=2
WRITE !?2,"Pt has given permission to leave anticoag msg on msg machine."
+92 IF $PIECE($GET(^ORAM(103,DFN,4,0)),"^",3)>0
SET ORAMCNT=$PIECE(^ORAM(103,DFN,4,0),"^",3)
Begin DoDot:1
+93 WRITE !?2,"OK to leave anticoagulation message with:"
+94 FOR ORAMJ=1:1:ORAMCNT
WRITE !?4,^ORAM(103,DFN,4,ORAMJ,0)
End DoDot:1
+95 IF $PIECE($GET(^ORAM(103,DFN,2,0)),"^",3)>0
SET ORAMCNT=$PIECE(^ORAM(103,DFN,2,0),"^",3)
Begin DoDot:1
+96 WRITE !!,"Secondary Indication(s)/Risk Factors:"
+97 FOR ORAMJ=1:1:ORAMCNT
WRITE !?2,^ORAM(103,DFN,2,ORAMJ,0)
End DoDot:1
+98 WRITE !
+99 IF $PIECE(^ORAM(103,DFN,0),"^",5)'=""
WRITE !,"Start Date: ",$PIECE(^ORAM(103,DFN,0),"^",5)
+100 IF $PIECE(^ORAM(103,DFN,0),"^",7)'=""
WRITE ?35,"Duration: ",$PIECE(^ORAM(103,DFN,0),"^",7)
+101 WRITE !,"==========================================================================="
+102 WRITE !,"DATE",?10,"INR",?18,"Notified",?30,"TWD",?36,"Comments:"
+103 WRITE !,"---------------------------------------------------------------------------"
+104 IF $DATA(^ORAM(103,DFN,3,"B"))
Begin DoDot:1
+105 NEW ORAMFSD
SET ORAMFSD=" "
SET ORAMCNT=0
+106 FOR
SET ORAMFSD=$ORDER(^ORAM(103,DFN,3,ORAMFSD),-1)
if $GET(ORAMFSD)<1
QUIT
Begin DoDot:2
+107 ;need to change this to the new date
IF $$DTCHK^ORAM2(DFN,ALPHA,OMEGA,ORAMFSD)=0
QUIT
+108 NEW ORAMDD1,ORAMDOSE,ORAMPS,ORAMPNOT
+109 ;changed from $P(^ORAM(103,DFN,3,ORAMCNT,0),"^")
IF '+$DATA(^ORAM(103,DFN,3,ORAMFSD,"LOG",0))
WRITE !,$$FMTE^XLFDT($EXTRACT($PIECE(^ORAM(103,DFN,3,ORAMFSD,0),"^",9),1,7),2)
+110 IF +$DATA(^ORAM(103,DFN,3,ORAMFSD,"LOG",0))
SET ORAMDD1=$PIECE($PIECE(^ORAM(103,DFN,3,ORAMFSD,"LOG",1,0),"(",2),".")
if '+$GET(ORAMDD1)
QUIT
WRITE !,$$FMTE^XLFDT(ORAMDD1,2)
+111 SET ORAMPNOT=$$WRAP($PIECE(^ORAM(103,DFN,3,ORAMFSD,0),"^",8),11)
+112 ;INR
WRITE ?11,$PIECE(^ORAM(103,DFN,3,ORAMFSD,0),"^",3)
+113 ;Pt Notified
WRITE ?18,$PIECE(ORAMPNOT,"|")
+114 ;TWD
WRITE ?30,$PIECE(^ORAM(103,DFN,3,ORAMFSD,0),"^",6)
+115 ; Comments
+116 IF $PIECE($GET(^ORAM(103,DFN,3,ORAMFSD,1,0)),"^",3)>0
Begin DoDot:3
+117 NEW ORAMCC,ORAMCLN
SET (ORAMCC,ORAMCLN)=0
+118 FOR
SET ORAMCLN=$ORDER(^ORAM(103,DFN,3,ORAMFSD,1,ORAMCLN))
if +ORAMCLN'>0
QUIT
Begin DoDot:4
+119 IF $PIECE(^ORAM(103,DFN,3,ORAMFSD,0),"^",3)'=""
IF ORAMCLN=2
WRITE ?10,$$FMTE^XLFDT($PIECE(^ORAM(103,DFN,3,ORAMFSD,0),"^"),2)
+120 if ORAMCLN>1
WRITE ?18,$PIECE(ORAMPNOT,"|",ORAMCLN)
+121 WRITE ?38,^ORAM(103,DFN,3,ORAMFSD,1,ORAMCLN,0),!
+122 SET ORAMCC=ORAMCC+1
End DoDot:4
+123 IF $LENGTH(ORAMPNOT,"|")>ORAMCC
Begin DoDot:4
+124 NEW ORAMI
SET ORAMI=0
FOR ORAMI=ORAMCC+1:1:$LENGTH(ORAMPNOT,"|")
WRITE ?18,$PIECE(ORAMPNOT,"|",ORAMI),!
End DoDot:4
End DoDot:3
IF 1
+125 IF '$TEST
Begin DoDot:3
+126 IF $LENGTH(ORAMPNOT,"|")>1
Begin DoDot:4
+127 NEW ORAMI
SET ORAMI=0
FOR ORAMI=2:1:$LENGTH(ORAMPNOT,"|")
WRITE ?18,$PIECE(ORAMPNOT,"|",ORAMI),!
End DoDot:4
End DoDot:3
WRITE !
+128 ; Patient Instructions
+129 IF +$ORDER(^ORAM(103,DFN,3,ORAMFSD,3,0))
Begin DoDot:3
+130 NEW ORI
SET ORI=0
+131 WRITE !,"Patient Instructions (from Letter):"
+132 FOR
SET ORI=$ORDER(^ORAM(103,DFN,3,ORAMFSD,3,ORI))
if +ORI'>0
QUIT
Begin DoDot:4
+133 NEW ORPILN,ORJ
SET ORPILN=$GET(^ORAM(103,DFN,3,ORAMFSD,3,ORI,0))
+134 if $LENGTH(ORPILN)>77
SET ORPILN=$$WRAP(ORPILN,77)
+135 FOR ORJ=1:1:$LENGTH(ORPILN,"|")
WRITE !?2,$PIECE(ORPILN,"|",ORJ)
End DoDot:4
+136 WRITE !
End DoDot:3
+137 ; Daily Dosing
+138 SET ORAMDOSE=$PIECE(^ORAM(103,DFN,3,ORAMFSD,0),"^",7)
+139 IF $LENGTH(ORAMDOSE)
Begin DoDot:3
+140 NEW ORAMTP,ORAMTM,ORI
+141 SET ORAMPS=$PIECE(^ORAM(103,DFN,3,ORAMFSD,0),"^",5)
SET (ORAMTP,ORAMTM)=0
+142 WRITE !,"Current Dosing (using ",ORAMPS," mg tab):",!
+143 WRITE ?6,$JUSTIFY("Sun",6),?12,$JUSTIFY("Mon",6),?18,$JUSTIFY("Tue",6),?24,$JUSTIFY("Wed",6),?30,$JUSTIFY("Thu",6),?36,$JUSTIFY("Fri",6),?42,$JUSTIFY("Sat",6),?48,$JUSTIFY("Tot",6),!
+144 WRITE "Tab"
FOR ORI=1:1:$LENGTH(ORAMDOSE,"|")
SET ORAMTP=ORAMTP+($PIECE(ORAMDOSE,"|",ORI)/ORAMPS)
WRITE ?(6*ORI),$JUSTIFY(($PIECE(ORAMDOSE,"|",ORI)/ORAMPS),6)
+145 WRITE ?48,$JUSTIFY(ORAMTP,6),!
+146 WRITE "mgs"
FOR ORI=1:1:$LENGTH(ORAMDOSE,"|")
SET ORAMTM=ORAMTM+$PIECE(ORAMDOSE,"|",ORI)
WRITE ?(6*ORI),$JUSTIFY($PIECE(ORAMDOSE,"|",ORI),6)
+147 WRITE ?48,$JUSTIFY(ORAMTM,6),!
End DoDot:3
+148 ; Complications
+149 IF +$PIECE(^ORAM(103,DFN,3,ORAMFSD,0),"^",2)
Begin DoDot:3
+150 NEW ORAMCTXT,ORAMCMPL
+151 SET ORAMCTXT=$SELECT($PIECE(^ORAM(103,DFN,3,ORAMFSD,0),"^",2)=1:"Major Bleed ",$PIECE(^(0),"^",2)=2:"Complication(s) ",$PIECE(^(0),"^",2)=3:"Minor Bleed ",1:"")
+152 IF $DATA(^ORAM(103,DFN,3,ORAMFSD,2))
NEW ORAMRSF
SET ORAMRSF=0
FOR
SET ORAMRSF=$ORDER(^ORAM(103,DFN,3,ORAMFSD,2,ORAMRSF))
if ORAMRSF<1
QUIT
Begin DoDot:4
+153 NEW ORI
+154 IF ORAMRSF=1
WRITE ?38,ORAMCTXT,"noted: (",^ORAM(103,DFN,3,ORAMFSD,2,ORAMRSF,0),")",!
QUIT
+155 SET ORAMCMPL=^ORAM(103,DFN,3,ORAMFSD,2,ORAMRSF,0)
+156 IF $SELECT(ORAMCMPL["MB:":1,ORAMCMPL["C:":1,1:0)
SET ORAMCMPL=$PIECE(ORAMCMPL,":",2)
+157 IF $LENGTH(ORAMCMPL)>37
SET ORAMCMPL=$$WRAP(ORAMCMPL,37)
+158 FOR ORI=1:1:$LENGTH(ORAMCMPL,"|")
WRITE ?$SELECT(ORI=1:38,1:40),$PIECE(ORAMCMPL,"|",ORI),!
End DoDot:4
End DoDot:3
+159 WRITE ?38,"-------------------------------------",!
End DoDot:2
End DoDot:1
+160 QUIT
+161 ;
WRAP(TEXT,LENGTH) ; Breaks text string into substrings of length LENGTH
+1 NEW ORAMI,ORAMJ,LINE,ORAMX,ORAMX1,ORAMX2,ORAMY
+2 IF $GET(TEXT)']""
QUIT ""
+3 FOR ORAMI=1:1
Begin DoDot:1
+4 SET ORAMX=$PIECE(TEXT," ",ORAMI)
+5 IF $LENGTH(ORAMX)>LENGTH
Begin DoDot:2
+6 SET ORAMX1=$EXTRACT(ORAMX,1,LENGTH)
SET ORAMX2=$EXTRACT(ORAMX,LENGTH+1,$LENGTH(ORAMX))
+7 SET $PIECE(TEXT," ",ORAMI)=ORAMX1_" "_ORAMX2
End DoDot:2
End DoDot:1
if ORAMI=$LENGTH(TEXT," ")
QUIT
+8 SET LINE=1
SET ORAMX(1)=$PIECE(TEXT," ")
+9 FOR ORAMI=2:1
Begin DoDot:1
+10 if $LENGTH($GET(ORAMX(LINE))_" "_$PIECE(TEXT," ",ORAMI))>LENGTH
SET LINE=LINE+1
SET ORAMY=1
+11 SET ORAMX(LINE)=$GET(ORAMX(LINE))_$SELECT(+$GET(ORAMY):"",1:" ")_$PIECE(TEXT," ",ORAMI)
SET ORAMY=0
End DoDot:1
if ORAMI'<$LENGTH(TEXT," ")
QUIT
+12 SET ORAMJ=0
SET TEXT=""
FOR ORAMI=1:1
SET ORAMJ=$ORDER(ORAMX(ORAMJ))
if +ORAMJ'>0
QUIT
SET TEXT=TEXT_$SELECT(ORAMI=1:"",1:"|")_ORAMX(ORAMJ)
+13 QUIT TEXT
+14 ;
GETVSIT(ORDXS,ORDFN,ORVDT,ORLOC) ; Find the Visit for a given Pt, Location, and Visit Date(/Time)
+1 NEW ORVSIT,ORI
+2 KILL ^TMP("PXKENC",$JOB)
+3 SET ORDXS=0
+4 SET ORVSIT=$$GETENC^PXAPI(ORDFN,ORVDT,ORLOC)
+5 IF +ORVSIT'>0
SET ORDXS=ORDXS_"^No Visit Found"
QUIT
+6 IF '$DATA(^TMP("PXKENC",$JOB,ORVSIT,"POV"))
SET ORDXS=ORDXS_"^No Dxs for Visit"
QUIT
+7 SET ORI=0
+8 FOR
SET ORI=$ORDER(^TMP("PXKENC",$JOB,ORVSIT,"POV",ORI))
if +ORI'>0
QUIT
Begin DoDot:1
+9 NEW ORPOV,ORDX,ORDXC,ORDXT
+10 SET ORPOV=$GET(^TMP("PXKENC",$JOB,ORVSIT,"POV",ORI,0))
+11 SET ORDX=$PIECE(ORPOV,U)
if +ORDX'>0
QUIT
+12 SET ORDXC=$$CODEC^ICDEX(80,ORDX)
+13 SET ORDXT=$$TITLE^XLFSTR($$VLTD^ICDEX(ORDX,ORVDT))
+14 SET ORDXS=ORDXS+1
+15 SET ORDXS(ORDXS)=ORDXC_U_$$SETNARR^ORWPCE3($PIECE(ORPOV,U,4),ORDXC)
End DoDot:1
+16 KILL ^TMP("PXKENC",$JOB)
+17 QUIT
