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

ORWRP1.m

Go to the documentation of this file. 
  1. ORWRP1 ; ALB/MJK,dcm Report Calls ;9/18/96  15:02
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,109,160,262,212**;Dec 17, 1997;Build 24
  1.  ;
  1. AHS(ROOT,ORDFN,ORHS,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ; - get adhoc health summary report
  1.  D START^ORWRP(80,"AHSB^ORWRP1(.ROOT,.ORDFN,.ORHS,.ALPHA,.OMEGA,.DTRANGE,.REMOTE,.ORMAX,.ORFHIE)")
  1.  Q
  1. AHSB(ROOT,ORDFN,ORHS,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ; -build adhoc health summary
  1.  N ORVP,GMTYP,Y
  1.  S ORVP=ORDFN_";DPT(",Y=$P($G(^GMT(142,+ORHS,0)),U),GMTSTYP=+ORHS
  1.  D ADHOC^ORPRS13
  1.  Q
  1. HS(ROOT,ORDFN,ORHS,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ; - get health summary report
  1.  D START^ORWRP(80,"HSB^ORWRP1(.ROOT,.ORDFN,.ORHS,.ALPHA,.OMEGA,.DTRANGE,.REMOTE,.ORMAX,.ORFHIE)")
  1.  Q
  1. HSB(ROOT,ORDFN,ORHS,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ; - build health summary report
  1.  N I,ICN,ORVP,GMTYP,Y,GMARXN,GMTSDLM,GMTSDTC,GMTSE,GMTSEGH,GMTSEGL,GMTSEGN,GMTSEGR,GMSEQ,GMTSHDR,GMTSLCMP,GMTSNDM,GMTSNPK,GMTSPG,GMTSPHDR,X
  1.  I $G(REMOTE) D  Q:'ORHS
  1.  . S Y=$O(^GMT(142,"E",$P(ORHS,";",2),0))
  1.  . I 'Y S Y=$O(^GMT(142,"E",$P($$UPPER^ORU(ORHS),";",2),0))
  1.  . I 'Y S I=0 F  S I=$O(^GMT(142,I)) Q:'I  I $L($P($G(^GMT(142,I,"T")),"^")),$P($$UPPER^ORU(ORHS),";",2)=$$UPPER^ORU(^("T")) S Y=I Q
  1.  . I 'Y S Y=$O(^GMT(142,"B",$P(ORHS,";",2),0))
  1.  . I 'Y S Y=$O(^GMT(142,"B",$P($$UPPER^ORU(ORHS),";",2),0))
  1.  . I 'Y S I=0 F  S I=$O(^GMT(142,I)) Q:'I  S X=$P(^(I,0),"^") I $P($$UPPER^ORU(ORHS),";",2)=$$UPPER^ORU(X) S Y=I Q
  1.  . I 'Y U IO W !,ORHS_" not found on remote system",! S ORHS=Y Q
  1.  . S ORHS=Y
  1.  I +$G(ORHS)<1 W !,"Report not Available" Q
  1.  S ORVP=ORDFN_";DPT(",Y=$P($G(^GMT(142,+ORHS,0)),U),GMTYP(0)=1,GMTYP(1)=+ORHS_U_Y_U_Y_U_Y
  1.  D PQ^ORPRS13
  1.  Q
  1. HSTYPE(ROOT,ORDFN,ORHS,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ; - Get HS type report
  1.  D START^ORWRP(80,"HSTYPEB^ORWRP1(.ROOT,.ORDFN,.ORHS,.ALPHA,.OMEGA,.DTRANGE,.REMOTE,.ORMAX,.ORFHIE)")
  1.  Q
  1. HSTYPEB(ROOT,ORDFN,ORHS,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ; - Build HS type report
  1.  N GMTSQIT,GMTSPRM,GMTSTITL,GMTSPX2,GMTSPX1
  1.  I $L($G(DTRANGE)),'$G(ALPHA) S ALPHA=$$FMADD^XLFDT(DT,-DTRANGE),OMEGA=$$NOW^XLFDT
  1.  Q:'$G(ALPHA)  Q:'$G(OMEGA)
  1.  I +$G(ORHS)<1 W !,"Report not Available" Q
  1.  S GMTSQIT=1,GMTSPRM=$P($G(^GMT(142.1,+ORHS,0)),"^",4),GMTSTITL="",GMTSPX2=ALPHA,GMTSPX1=OMEGA,DFN=ORDFN
  1.  D ENCWA^GMTS
  1.  Q
  1. HSGUI(DFN,GMTSTYP) ; - Call ENX^GMTSDVR to print HS Type for Patient
  1.  D ENX^GMTSDVR(DFN,GMTSTYP)
  1.  Q
  1. BLR(ROOT,ORDFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ; -- get 'enhanced' blood bank report
  1.  D BB^ORWRP2
  1.  Q
  1. AP(ROOT,ORDFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ; -- get Anatomic path report
  1.  N I,C,LINES,X
  1.  K ^TMP("LRC",$J),^TMP("LRH",$J)
  1.  D AP^LR7OSUM(ORDFN)
  1.  I '$O(^TMP("LRC",$J,0)) S ^TMP("LRC",$J,1,0)="",^TMP("LRC",$J,2,0)="No Anatomic Pathology reports available..."
  1.  S I=0
  1.  I $L($O(^TMP("LRH",$J,0))) S I=.001,^TMP("LRC",$J,I)="[HIDDEN TEXT]^" D
  1.  . S X="",C=2 F  S X=$O(^TMP("LRH",$J,X)) Q:X=""  S LINES(^(X))=X,C=C+1
  1.  . S $P(^TMP("LRC",$J,.001),"^",2)=C
  1.  . S X="" F  S X=$O(LINES(X)) Q:X=""  D
  1.  .. S I=I+.001,^TMP("LRC",$J,I)=X_"^"_LINES(X)
  1.  . S I=I+.001,^TMP("LRC",$J,I)="[REPORT TEXT]"
  1.  S ROOT=$NA(^TMP("LRC",$J))
  1.  K ^TMP("LRH",$J)
  1.  Q
  1. DIET(ROOT,DFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ; -- get dietetics profile
  1.  N LCNT,ORVP
  1.  S LCNT=0,ORVP=DFN_";DPT("
  1.  D FHP^ORCXPNDR
  1.  S ROOT=$NA(^TMP("ORXPND",$J))
  1.  Q
  1. LISTNUTR(ROOT,DFN) ; -- list nutritional assessments
  1.  N OK,I,X,SITE
  1.  K ^TMP($J,"FHADT")
  1.  S OK=$$FHWORADT^FHWORA(DFN)
  1.  S I=0,SITE=$$SITE^VASITE,SITE=$P(SITE,"^",2)_";"_$P(SITE,"^",3)
  1.  F  S I=$O(^TMP($J,"FHADT",DFN,I)) Q:'I  S X=SITE_U_I_U_^(I),^(I)=X
  1.  S ROOT=$NA(^TMP($J,"FHADT",DFN))
  1.  Q
  1. NUTR(ROOT,DFN,ID,ALPHA,OMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ; -- get nutritional assessment
  1.  N LCNT,ORVP
  1.  K ^TMP("ORXPND",$J)
  1.  S LCNT=0,ORVP=DFN_";DPT(",ID=DFN_";"_ID
  1.  D FHA^ORCXPNDR
  1.  S ROOT=$NA(^TMP("ORXPND",$J))
  1.  Q
  1. VITALS(ROOT,ORDFN,ID,ALPHA,OMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ; -- get vitals report
  1.  D START^ORWRP(132,"VITALSB^ORWRP1(.ROOT,.ORDFN,.ID,.ALPHA,.OMEGA,.ORDTRNG,.REMOTE,.ORMAX,.ORFHIE)")
  1.  Q
  1. VITALSB(ROOT,ORDFN,ID,ALPHA,OMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ; -- build vitals report
  1.  N ORVP,XQORNOD,ORSSTRT,ORSSTOP
  1.  Q:'$G(ORDFN)
  1.  I $L(ORDTRNG),'$G(ALPHA) S ALPHA=$$FMADD^XLFDT(DT,-ORDTRNG),OMEGA=$$NOW^XLFDT
  1.  Q:'$G(ALPHA)  Q:'$G(OMEGA)
  1.  I '$P(OMEGA,".",2) S OMEGA=OMEGA_".2359"
  1.  S ORVP=ORDFN_";DPT(",XQORNOD=1,ORSSTRT(XQORNOD)=ALPHA,ORSSTOP(XQORNOD)=OMEGA
  1.  D VITCUM^ORPRS14
  1.  Q
  1. STAT(ROOT,ORDFN,ID,ORALPHA,OROMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;Lab Order Status
  1.  N ORVP
  1.  K ^TMP("ORDATA",$J)
  1.  S ORVP=ORDFN_";DPT("
  1.  D EN1^LR7OSOS1(.ORY,ORVP,.ORALPHA,.OROMEGA,.ORDTRNG)
  1.  I '$O(^TMP("ORDATA",$J,1,0)) S ^TMP("ORDATA",$J,1,1,0)="",^TMP("ORDATA",$J,1,2,0)="No Orders found..."
  1.  S ROOT=ORY
  1.  Q
  1. INTERIM(ROOT,ORDFN,ID,ORALPHA,OROMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Lab Interim
  1.  D START^ORWRP(80,"INTERIMB^ORWRP1(.ROOT,.ORDFN,.ID,.ORALPHA,.OROMEGA,.DTRANGE,.REMOTE,.ORMAX,.ORFHIE)")
  1.  Q
  1. INTERIMB(ROOT,DFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Build Interim
  1.  Q:'$G(DFN)  Q:'$G(ALPHA)  Q:'$G(OMEGA)
  1.  N ORVP,XQORNOD,ORSSTRT,ORSSTOP,LRACC,LRAD,LRAN,LRRT,LRPG,LRSB,LREDT,LRIDT
  1.  S ORVP=DFN_";DPT(",XQORNOD=1,(ORSSTRT(XQORNOD),LREDT)=(9999999-ALPHA),(ORSSTOP(XQORNOD),LRIDT)=(9999999-OMEGA)
  1.  D OERR^LRRP4,CLEAN^LRRP4
  1.  Q
  1. LRGEN(ROOT,ORDFN,ID,ORALPHA,OROMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Lab results by test
  1.  D START^ORWRP(80,"LRGENB^ORWRP1(.ROOT,.ORDFN,.ID,.ORALPHA,.OROMEGA,.DTRANGE,.REMOTE,.ORMAX,.ORFHIE)")
  1.  Q
  1. LRGENB(ROOT,DFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Build Results
  1.  Q:'$G(DFN)  Q:'$G(ALPHA)  Q:'$G(OMEGA)
  1.  N ORVP,ORSSTRT,ORSSTOP,LREDT,LRSDT,XQORNOD
  1.  S ORVP=DFN_";DPT(",XQORNOD=1,(ORSSTRT(XQORNOD),LREDT)=(9999999-ALPHA),(ORSSTOP(XQORNOD),LRSDT)=(9999999-OMEGA)
  1.  D SET1^LRGEN,CLEAN^LRRP4
  1.  K LRPR
  1.  Q
  1. GRAPH(ROOT,ORDFN,ID,ORALPHA,OROMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Graph labs
  1.  D START^ORWRP(80,"GRAPHB^ORWRP1(.ROOT,.ORDFN,.ID,.ORALPHA,.OROMEGA,.DTRANGE,.REMOTE,.ORMAX,.ORFHIE)")
  1.  Q
  1. GRAPHB(ROOT,DFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Graph labs
  1.  Q:'$G(DFN)  Q:'$G(ALPHA)  Q:'$G(OMEGA)
  1.  N ORVP,XQORNOD,ORSSTRT,ORSSTOP,LREDT,LRSDT
  1.  S ORVP=DFN_";DPT(",XQORNOD=1,(ORSSTRT(XQORNOD),LREDT)=ALPHA,(ORSSTOP(XQORNOD),LRSDT)=OMEGA
  1.  D OERR^LRDIST4,CLEAN^LRDIST4
  1.  Q
  1. ORS(ROOT,ORDFN,ID,ALPHA,OMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;Daily order summary
  1.  D START^ORWRP(80,"ORSB^ORWRP1(.ROOT,.ORDFN,.ID,.ALPHA,.OMEGA,.ORDTRNG,.REMOTE,.ORMAX,.ORFHIE)")
  1.  Q
  1. ORSB(ROOT,DFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Daily order summary
  1.  N ORVP,XQORNOD,ORSSTRT,ORSSTOP
  1.  S ORVP=DFN_";DPT(",XQORNOD=1,X1=DT,X2=-$S(DTRANGE:DTRANGE-1,1:0)
  1.  D C^%DTC
  1.  S ORSSTRT=X-.7641,ORSSTOP=DT+.2359
  1.  D DAY^ORPRS02
  1.  Q
  1. ORD(ROOT,ORDFN,ID,ORALPHA,OROMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;Order Summary for Date Range
  1.  D START^ORWRP(80,"ORDB^ORWRP1(.ROOT,.ORDFN,.ID,.ORALPHA,.OROMEGA,.ORDTRNG,.REMOTE,.ORMAX,.ORFHIE)")
  1.  Q
  1. ORDB(ROOT,DFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Order Summary for Date Range
  1.  Q:'$G(DFN)
  1.  I $L($G(DTRANGE)),'$G(ALPHA) S ALPHA=$$FMADD^XLFDT(DT,-DTRANGE),OMEGA=$$NOW^XLFDT
  1.  Q:'$G(ALPHA)  Q:'$G(OMEGA)
  1.  N ORVP,XQORNOD,ORSSTRT,ORSSTOP
  1.  S ORVP=DFN_";DPT(",XQORNOD=1,ORSSTRT=ALPHA,ORSSTOP=OMEGA
  1.  D RANGE^ORPRS02
  1.  Q
  1. ORC(ROOT,ORDFN,ID,ORALPHA,OROMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Custom order summary
  1.  D START^ORWRP(80,"ORCB^ORWRP1(.ROOT,.ORDFN,.ID,.ORALPHA,.OROMEGA,.DTRANGE,.REMOTE,.ORMAX,.ORFHIE)")
  1.  Q
  1. ORCB(ROOT,DFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Custom order summary build
  1.  Q:'$G(DFN)  Q:'$G(ALPHA)  Q:'$G(OMEGA)
  1.  N ORVP,XQORNOD,ORSSTRT,ORSSTOP
  1.  S ORVP=DFN_";DPT(",XQORNOD=1,ORSSTRT=ALPHA,ORSSTOP=OMEGA
  1.  D CUSTOM^ORPRS02
  1.  Q
  1. ORP(ROOT,ORDFN,ID,ORALPHA,OROMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;Chart copy summary
  1.  D START^ORWRP(80,"ORPB^ORWRP1(.ROOT,.ORDFN,.ID,.ORALPHA,.OROMEGA,.ORDTRNG,.REMOTE,.ORFHIE)")
  1.  Q
  1. ORPB(ROOT,DFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Chart copy summary
  1.  Q:'$G(DFN)
  1.  I $L($G(DTRANGE)),'$G(ALPHA) S ALPHA=$$FMADD^XLFDT(DT,-DTRANGE),OMEGA=$$NOW^XLFDT
  1.  Q:'$G(ALPHA)  Q:'$G(OMEGA)
  1.  N ORVP,XQORNOD,ORSSTRT,ORSSTOP
  1.  S ORVP=DFN_";DPT(",XQORNOD=1,ORSSTRT=ALPHA,ORSSTOP=OMEGA
  1.  D CHART^ORPRS02
  1.  Q
  1. PSO(ROOT,ORDFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Outpatient RX Profile
  1.  D START^ORWRP(80,"PSOB^ORWRP1(.ROOT,.ORDFN,.ID,.ALPHA,.OMEGA,.DTRANGE,.REMOTE,.ORFHIE)")
  1.  Q
  1. PSOB(ROOT,DFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Outpatient RX Action Profile
  1.  N ORVP,PSTYPE,PSONOPG
  1.  S ORVP=DFN_";DPT(",PSTYPE=1,PSONOPG=2
  1.  D DFN^PSOSD1
  1.  Q
  1. MED(ROOT,ORDFN,IID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Medicine Summary of Procedures
  1.  D START^ORWRP(80,"MEDB^ORWRP1(.ROOT,.ORDFN,.IID,.ALPHA,.OMEGA,.DTRANGE,.REMOTE,.ORMAX,.ORFHIE)")
  1.  Q
  1. MEDB(ROOT,DFN,IID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Medicine Summary of Procedures
  1.  Q:'$L($G(IID))
  1.  N ORVP,XQY0,OT,MCARPPS,MCPRO,MCARGRTN,DXS,SSN,I,J,L,DA,MCARGDA
  1.  S ORVP=DFN_";DPT(",XQY0="",OT=$G(^TMP("OR",$J,"MCAR","OT",IID))
  1.  Q:'$L(OT)
  1.  S (DA,MCARGDA)=$P(OT,U,2),MCARPPS=$P(OT,U,3,4),MCPRO=$P(OT,U,11)
  1.  D MCPPROC^MCARP
  1.  S MCARGRTN=$P(OT,U,5)
  1.  D @MCARPPS
  1.  Q
  1. PROB(ROOT,ORDFN,IID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ; Problem List (Problem Tab)
  1.  D START^ORWRP(80,"PROBB^ORWRP1(.ROOT,.ORDFN,.IID,.ALPHA,.OMEGA,.DTRANGE,.REMOTE,.ORMAX,.ORFHIE)")
  1.  Q
  1. PROBB(ROOT,DFN,IID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Problem List
  1.  N ORSILENT S ORSILENT=1
  1.  D VAF^GMPLUTL2(DFN,ORSILENT)
  1.  Q