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