Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORAMX1

ORAMX1.m

Go to the documentation of this file. 
  1. ORAMX1 ;ISL/JER - ADDITIONAL ANTICOAGULATION CALLS ;12/05/14  09:42
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**391**;Dec 17, 1997;Build 11
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified
  1.  Q
  1.  ;
  1. RPT(ROOT,DFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,MAX,ORFHIE) ; Generate report for CPRS
  1.  N ORAMCNT,ORAMJ,ORAMHCT,ORAMCLIN,ORAMPIND,ORAMSIND,ORAICODE,ORAINARR,ORAITXT,ORAIDESC,ORAIND,ORVDT,ORDXS,IMPLDT,CODSYS
  1.  I '$D(^ORAM(103,"B",DFN)) Q
  1.  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)
  1.  I $P(^ORAM(103,DFN,0),"^",10)=1 W !,?10,"******* COMPLEX PATIENT *******"
  1.  S ORAMCLIN=$P($G(^ORAM(103,DFN,6)),U,2),(ORAMPIND,ORAMSIND)=""
  1.  S ORVDT=$O(^ORAM(103,DFN,3,"B",""),-1)
  1.  I +ORVDT'>0 S ORVDT=DT
  1.  E  D
  1.  . N ORDA,ORDFS0
  1.  . S ORDA=$O(^ORAM(103,DFN,3,"B",ORVDT,0)) Q:+ORDA'>0
  1.  . S ORDFS0=$G(^ORAM(103,DFN,3,ORDA,0))
  1.  . S:$P(ORDFS0,U,9)>0 ORVDT=$P(ORDFS0,U,9)
  1.  . D:+ORAMCLIN GETVSIT(.ORDXS,DFN,ORVDT,ORAMCLIN)
  1.  S IMPLDT=$$IMPDATE^LEXU("10D")
  1.  S CODSYS=$S(ORVDT<IMPLDT:"ICD-9-CM",1:"ICD-10-CM")
  1.  I +$G(ORDXS)'>0 D  I 1
  1.  . N ICDCS
  1.  . I +ORAMCLIN D
  1.  .. N ICDC
  1.  .. I ORVDT<IMPLDT D  I 1
  1.  ... S ICDC=$$GET^XPAR(ORAMCLIN_";SC(","ORAM AUTO PRIMARY INDICATION",1,"E")
  1.  .. E  D
  1.  ... S ICDC=$$GET^XPAR(ORAMCLIN_";SC(","ORAM I10 AUTO PRIM INDICATION",1,"E")
  1.  .. I ICDC]"" D
  1.  ... N ICDD,ICDDESC,ICDCS
  1.  ... S ICDCS=$P($$CODECS^ICDEX(ICDC,80,ORVDT),U,2) S:ICDCS]"" CODSYS=ICDCS
  1.  ... D ICDDESC^ICDXCODE("DIAGNOSIS",ICDC,ORVDT,.ICDDESC)
  1.  ... S ORAMPIND=ICDC_U_$$TITLE^XLFSTR($G(ICDDESC(1)))_" ("_CODSYS_" "_ICDC_")"
  1.  .. S ICDC=""
  1.  .. I ORVDT<IMPLDT D  I 1
  1.  ... S ICDC=$$GET^XPAR(ORAMCLIN_";SC(","ORAM AUTO SECONDARY INDICATION",1,"E")
  1.  .. E  D
  1.  ... S ICDC=$$GET^XPAR(ORAMCLIN_";SC(","ORAM I10 AUTO SEC INDICATION",1,"E")
  1.  .. I ICDC]"" D
  1.  ... N ICDD,ICDDESC,ICDCS
  1.  ... S ICDCS=$P($$CODECS^ICDEX(ICDC,80,ORVDT),U,2) S:ICDCS]"" CODSYS=ICDCS
  1.  ... D ICDDESC^ICDXCODE("DIAGNOSIS",ICDC,ORVDT,.ICDDESC)
  1.  ... S ORAMSIND=ICDC_U_$$TITLE^XLFSTR($G(ICDDESC(1)))_" ("_CODSYS_" "_ICDC_")"
  1.  . S ORAITXT=$P($P(^ORAM(103,DFN,0),"^",3),"=")
  1.  . S ORAICODE=$P($P(^ORAM(103,DFN,0),"^",3),"=",2) S:ORAICODE'["." ORAICODE=ORAICODE_"."
  1.  . S ICDCS=$P($$CODECS^ICDEX(ORAICODE,80,ORVDT),U,2) S:ICDCS]"" CODSYS=ICDCS
  1.  . D ICDDESC^ICDXCODE("DIAGNOSIS",ORAICODE,ORVDT,.ORAIDESC)
  1.  . S ORAINARR=$$TITLE^XLFSTR($G(ORAIDESC(1)))
  1.  . S ORAIND=ORAICODE_U_$S($$UP^XLFSTR(ORAITXT)'=$$UP^XLFSTR(ORAINARR):ORAITXT_" - ",1:"")_ORAINARR_" ("_CODSYS_" "_ORAICODE_")"
  1.  . I ORAMPIND]"" D
  1.  .. N PIND,AIND,ORI
  1.  .. S PIND=$$WRAP($P(ORAMPIND,U,2),55)
  1.  .. W !!,"Primary Indication: ",$P(PIND,"|")
  1.  .. F ORI=2:1:$L(PIND,"|") W !?22,$P(PIND,"|",ORI)
  1.  .. I ORAMSIND]"" D
  1.  ... N SIND,ORJ
  1.  ... S SIND=$$WRAP($P(ORAMSIND,U,2),55)
  1.  ... W !," Add'l Indications: ",$P(SIND,"|")
  1.  ... F ORJ=2:1:$L(SIND,"|") W !?22,$P(SIND,"|",ORJ)
  1.  .. S AIND=$$WRAP($P(ORAIND,U,2),55)
  1.  .. W !,$S($D(ORAMSIND):"                    ",1:"  Add'l Indication: "),$P(AIND,"|")
  1.  .. F ORI=2:1:$L(AIND,"|") W !?22,$P(AIND,"|",ORI)
  1.  . E  D
  1.  .. N AIND,ORI
  1.  .. S AIND=$$WRAP($P(ORAIND,U,2),55)
  1.  .. W !!,"Primary Indication: ",$P(AIND,"|")
  1.  .. F ORI=2:1:$L(AIND,"|") W !?22,$P(AIND,"|",ORI)
  1.  E  D
  1.  . N PIND,AIND,ORI,ORJ
  1.  . S PIND=$$WRAP($P(ORDXS(1),U,2),55)
  1.  . W !!,"Primary Indication: ",$P(PIND,"|")
  1.  . F ORI=2:1:$L(PIND,"|") W !?22,$P(PIND,"|",ORI)
  1.  . Q:ORDXS'>1
  1.  . S AIND=$$WRAP($P(ORDXS(2),U,2),55)
  1.  . W !?$S(ORDXS>2:1,1:2),"Add'l Indication",$S(ORDXS>2:"s",1:""),": ",$P(AIND,"|")
  1.  . F ORI=2:1:$L(AIND,"|") W !?22,$P(AIND,"|",ORI)
  1.  . F ORJ=3:1:ORDXS D
  1.  .. S AIND=$$WRAP($P(ORDXS(ORJ),U,2),55)
  1.  .. F ORI=1:1:$L(AIND,"|") W !?$S(ORI=1:20,1:22),$P(AIND,"|",ORI)
  1.  W !!,"          Goal INR: ",$P(^ORAM(103,DFN,0),"^",2)
  1.  D HCT^ORAM(.ORAMHCT,DFN)
  1.  I $L(ORAMHCT,U)>1 D  I 1
  1.  . W !?10,"Last ",$S($$UP^XLFSTR($P(ORAMHCT,U,3))["HGB":"Hgb",$$UP^XLFSTR($P(ORAMHCT,U,3))["HEMOGLOBIN":"Hgb",1:"HCT"),": "
  1.  . W $S($P(ORAMHCT,U)]"":$P(ORAMHCT,U),1:"No result")," on ",$S($P(ORAMHCT,U,2)]"":$P(ORAMHCT,U,2),1:"file")
  1.  E  W !!?10,ORAMHCT
  1.  I +$P($G(^ORAM(103,DFN,6)),U,5)!+$O(^ORAM(103,DFN,7,0)) D
  1.  . W !!,"Patient is Eligible for LMWH Bridging"
  1.  . I +$O(^ORAM(103,DFN,7,0)) D
  1.  .. N ORI S ORI=0
  1.  .. W ":"
  1.  .. F  S ORI=$O(^ORAM(103,DFN,7,ORI)) Q:+ORI'>0  W !?2,$G(^ORAM(103,DFN,7,ORI,0))
  1.  . E  W "."
  1.  I $P($G(^ORAM(103,DFN,1,0)),"^",3)>0 S ORAMCNT=$P(^ORAM(103,DFN,1,0),"^",3) D
  1.  . W !!,"Special Instructions:"
  1.  . F ORAMJ=1:1:ORAMCNT W !?2,^ORAM(103,DFN,1,ORAMJ,0)
  1.  I $P(^ORAM(103,DFN,0),"^",11)=2 W !?2,"Pt has given permission to leave anticoag msg on msg machine."
  1.  I $P($G(^ORAM(103,DFN,4,0)),"^",3)>0 S ORAMCNT=$P(^ORAM(103,DFN,4,0),"^",3) D
  1.  . W !?2,"OK to leave anticoagulation message with:"
  1.  . F ORAMJ=1:1:ORAMCNT W !?4,^ORAM(103,DFN,4,ORAMJ,0)
  1.  I $P($G(^ORAM(103,DFN,2,0)),"^",3)>0 S ORAMCNT=$P(^ORAM(103,DFN,2,0),"^",3) D
  1.  . W !!,"Secondary Indication(s)/Risk Factors:"
  1.  . F ORAMJ=1:1:ORAMCNT W !?2,^ORAM(103,DFN,2,ORAMJ,0)
  1.  W !
  1.  I $P(^ORAM(103,DFN,0),"^",5)'="" W !,"Start Date: ",$P(^ORAM(103,DFN,0),"^",5)
  1.  I $P(^ORAM(103,DFN,0),"^",7)'="" W ?35,"Duration: ",$P(^ORAM(103,DFN,0),"^",7)
  1.  W !,"==========================================================================="
  1.  W !,"DATE",?10,"INR",?18,"Notified",?30,"TWD",?36,"Comments:"
  1.  W !,"---------------------------------------------------------------------------"
  1.  I $D(^ORAM(103,DFN,3,"B")) D
  1.  . N ORAMFSD S ORAMFSD=" ",ORAMCNT=0
  1.  . F  S ORAMFSD=$O(^ORAM(103,DFN,3,ORAMFSD),-1) Q:$G(ORAMFSD)<1  D
  1.  .. I $$DTCHK^ORAM2(DFN,ALPHA,OMEGA,ORAMFSD)=0 Q  ;need to change this to the new date
  1.  .. N ORAMDD1,ORAMDOSE,ORAMPS,ORAMPNOT
  1.  .. 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),"^")
  1.  .. 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)
  1.  .. S ORAMPNOT=$$WRAP($P(^ORAM(103,DFN,3,ORAMFSD,0),"^",8),11)
  1.  .. W ?11,$P(^ORAM(103,DFN,3,ORAMFSD,0),"^",3) ;INR
  1.  .. W ?18,$P(ORAMPNOT,"|") ;Pt Notified
  1.  .. W ?30,$P(^ORAM(103,DFN,3,ORAMFSD,0),"^",6) ;TWD
  1.  .. ; Comments
  1.  .. I $P($G(^ORAM(103,DFN,3,ORAMFSD,1,0)),"^",3)>0 D  I 1
  1.  ... N ORAMCC,ORAMCLN S (ORAMCC,ORAMCLN)=0
  1.  ... F  S ORAMCLN=$O(^ORAM(103,DFN,3,ORAMFSD,1,ORAMCLN)) Q:+ORAMCLN'>0  D
  1.  .... I $P(^ORAM(103,DFN,3,ORAMFSD,0),"^",3)'="",ORAMCLN=2 W ?10,$$FMTE^XLFDT($P(^ORAM(103,DFN,3,ORAMFSD,0),"^"),2)
  1.  .... W:ORAMCLN>1 ?18,$P(ORAMPNOT,"|",ORAMCLN)
  1.  .... W ?38,^ORAM(103,DFN,3,ORAMFSD,1,ORAMCLN,0),!
  1.  .... S ORAMCC=ORAMCC+1
  1.  ... I $L(ORAMPNOT,"|")>ORAMCC D
  1.  .... N ORAMI S ORAMI=0 F ORAMI=ORAMCC+1:1:$L(ORAMPNOT,"|") W ?18,$P(ORAMPNOT,"|",ORAMI),!
  1.  .. E  D  W !
  1.  ... I $L(ORAMPNOT,"|")>1 D
  1.  .... N ORAMI S ORAMI=0 F ORAMI=2:1:$L(ORAMPNOT,"|") W ?18,$P(ORAMPNOT,"|",ORAMI),!
  1.  .. ; Patient Instructions
  1.  .. I +$O(^ORAM(103,DFN,3,ORAMFSD,3,0)) D
  1.  ... N ORI S ORI=0
  1.  ... W !,"Patient Instructions (from Letter):"
  1.  ... F  S ORI=$O(^ORAM(103,DFN,3,ORAMFSD,3,ORI)) Q:+ORI'>0  D
  1.  .... N ORPILN,ORJ S ORPILN=$G(^ORAM(103,DFN,3,ORAMFSD,3,ORI,0))
  1.  .... S:$L(ORPILN)>77 ORPILN=$$WRAP(ORPILN,77)
  1.  .... F ORJ=1:1:$L(ORPILN,"|") W !?2,$P(ORPILN,"|",ORJ)
  1.  ... W !
  1.  .. ; Daily Dosing
  1.  .. S ORAMDOSE=$P(^ORAM(103,DFN,3,ORAMFSD,0),"^",7)
  1.  .. I $L(ORAMDOSE) D
  1.  ... N ORAMTP,ORAMTM,ORI
  1.  ... S ORAMPS=$P(^ORAM(103,DFN,3,ORAMFSD,0),"^",5),(ORAMTP,ORAMTM)=0
  1.  ... W !,"Current Dosing (using ",ORAMPS," mg tab):",!
  1.  ... 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),!
  1.  ... W "Tab" F ORI=1:1:$L(ORAMDOSE,"|") S ORAMTP=ORAMTP+($P(ORAMDOSE,"|",ORI)/ORAMPS) W ?(6*ORI),$J(($P(ORAMDOSE,"|",ORI)/ORAMPS),6)
  1.  ... W ?48,$J(ORAMTP,6),!
  1.  ... W "mgs" F ORI=1:1:$L(ORAMDOSE,"|") S ORAMTM=ORAMTM+$P(ORAMDOSE,"|",ORI) W ?(6*ORI),$J($P(ORAMDOSE,"|",ORI),6)
  1.  ... W ?48,$J(ORAMTM,6),!
  1.  .. ; Complications
  1.  .. I +$P(^ORAM(103,DFN,3,ORAMFSD,0),"^",2) D
  1.  ... N ORAMCTXT,ORAMCMPL
  1.  ... 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:"")
  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
  1.  .... N ORI
  1.  .... I ORAMRSF=1 W ?38,ORAMCTXT,"noted: (",^ORAM(103,DFN,3,ORAMFSD,2,ORAMRSF,0),")",! Q
  1.  .... S ORAMCMPL=^ORAM(103,DFN,3,ORAMFSD,2,ORAMRSF,0)
  1.  .... I $S(ORAMCMPL["MB:":1,ORAMCMPL["C:":1,1:0) S ORAMCMPL=$P(ORAMCMPL,":",2)
  1.  .... I $L(ORAMCMPL)>37 S ORAMCMPL=$$WRAP(ORAMCMPL,37)
  1.  .... F ORI=1:1:$L(ORAMCMPL,"|") W ?$S(ORI=1:38,1:40),$P(ORAMCMPL,"|",ORI),!
  1.  .. W ?38,"-------------------------------------",!
  1.  Q
  1.  ;
  1. WRAP(TEXT,LENGTH) ; Breaks text string into substrings of length LENGTH
  1.  N ORAMI,ORAMJ,LINE,ORAMX,ORAMX1,ORAMX2,ORAMY
  1.  I $G(TEXT)']"" Q ""
  1.  F ORAMI=1:1 D  Q:ORAMI=$L(TEXT," ")
  1.  . S ORAMX=$P(TEXT," ",ORAMI)
  1.  . I $L(ORAMX)>LENGTH D
  1.  .. S ORAMX1=$E(ORAMX,1,LENGTH),ORAMX2=$E(ORAMX,LENGTH+1,$L(ORAMX))
  1.  .. S $P(TEXT," ",ORAMI)=ORAMX1_" "_ORAMX2
  1.  S LINE=1,ORAMX(1)=$P(TEXT," ")
  1.  F ORAMI=2:1 D  Q:ORAMI'<$L(TEXT," ")
  1.  . S:$L($G(ORAMX(LINE))_" "_$P(TEXT," ",ORAMI))>LENGTH LINE=LINE+1,ORAMY=1
  1.  . S ORAMX(LINE)=$G(ORAMX(LINE))_$S(+$G(ORAMY):"",1:" ")_$P(TEXT," ",ORAMI),ORAMY=0
  1.  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)
  1.  Q TEXT
  1.  ;
  1. GETVSIT(ORDXS,ORDFN,ORVDT,ORLOC) ; Find the Visit for a given Pt, Location, and Visit Date(/Time)
  1.  N ORVSIT,ORI
  1.  K ^TMP("PXKENC",$J)
  1.  S ORDXS=0
  1.  S ORVSIT=$$GETENC^PXAPI(ORDFN,ORVDT,ORLOC)
  1.  I +ORVSIT'>0 S ORDXS=ORDXS_"^No Visit Found" Q
  1.  I '$D(^TMP("PXKENC",$J,ORVSIT,"POV")) S ORDXS=ORDXS_"^No Dxs for Visit" Q
  1.  S ORI=0
  1.  F  S ORI=$O(^TMP("PXKENC",$J,ORVSIT,"POV",ORI)) Q:+ORI'>0  D
  1.  . N ORPOV,ORDX,ORDXC,ORDXT
  1.  . S ORPOV=$G(^TMP("PXKENC",$J,ORVSIT,"POV",ORI,0))
  1.  . S ORDX=$P(ORPOV,U) Q:+ORDX'>0
  1.  . S ORDXC=$$CODEC^ICDEX(80,ORDX)
  1.  . S ORDXT=$$TITLE^XLFSTR($$VLTD^ICDEX(ORDX,ORVDT))
  1.  . S ORDXS=ORDXS+1
  1.  . S ORDXS(ORDXS)=ORDXC_U_$$SETNARR^ORWPCE3($P(ORPOV,U,4),ORDXC)
  1.  K ^TMP("PXKENC",$J)
  1.  Q