ORWRPP ; ALB/MJK - Background Report Print Driver ;18-Jun-2009 08:41;PLS
;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,109,192,1002,1004,1010**;Dec 17, 1997;Build 47
; Modified - IHS/MSC/DKM - 06/18/09 - Line REMOTE+7, PRINT+9, and others
PRINT(ORY,ORIO,ORDFN,ORRPTID,ORHSTYPE,ORDTRNG,OREXAMID,ORCOMP,ORALPHA,OROMEGA) ; -- print report entry point
; RPC: ORWRP PRINT REPORT
; See RPC definition for details on input and output parameters
N ORHSTAG
S ORHSTAG=$P($G(ORRPTID),"~",2),ORRPTID=$P($G(ORRPTID),"~"),ORRPTID=$P($P(ORRPTID,";"),":")
IF '$$CHK() G PRINTQ
N ZTDTH,ZTRTN,ZTSK,ZTDESC,ZTSAVE,I,ZTIO
S ZTIO=ORIO,ZTDTH=$H
S ZTDESC="Report Print"
;S ZTRTN="DEQUE^ORWRPP"
S ZTRTN="DEQUE^ORWRPP()" ;IHS/CIA/DKM - 1/23/2006
F I="ORDFN","ORRPTID","ORHSTYPE","ORDTRNG","OREXAMID","DUZ(","ORCOMP(","ORALPHA","OROMEGA","ORHSTAG" S ZTSAVE(I)=""
D ^%ZTLOAD
I $D(ZTSK) D
. S ORY="0^Report queued. (Task #"_ZTSK_")"
E D
. S ORY="99^Task Rejected."
PRINTQ Q
REMOTE(ORY,ORIO,ORDFN,ORRPTID,ORHANDS) ;Print data for remote sites
; RPC: ORWRP PRINT REMOTE REPORT
N ZTDTH,ZTRTN,ZTSK,ZTDESC,ZTSAVE,I,ORHSTAG,ZTIO
S ORHSTAG=$P($G(ORRPTID),"~",2),ORRPTID=$P($G(ORRPTID),"~"),ORRPTID=$P($P(ORRPTID,";"),":")
S ZTIO=ORIO,ZTDTH=$H
S ZTDESC="Remote Report Print"
;S ZTRTN="DEQUE^ORWRPP"
S ZTRTN="DEQUE^ORWRPP()" ;IHS/CIA/DKM - 1/23/2006
F I="ORDFN","ORRPTID","ORHANDS(","ORHSTAG" S ZTSAVE(I)=""
D ^%ZTLOAD
I $D(ZTSK) D
. S ORY="0^Report queued. (Task #"_ZTSK_")"
E D
. S ORY="99^Task Rejected."
Q
; IHS/CIA/DKM - 1/23/2006 - Fixed problem with HFS data clobbering global data
PRINTW(ORTEXT,ORDFN,ORRPTID,ORHSTYPE,ORDTRNG,OREXAMID,ORCOMP,ORALPHA,OROMEGA) ;Windows device print
N ZTQUEUED,ORHFS,ORSUB,ROOT,ORIO,ORHANDLE,ORWINDEV
N IOM,IOSL,IOST,IOF,IOT,IOS,ORHSTAG,POP
S ORHSTAG=$P($G(ORRPTID),"~",2),ORRPTID=$P($G(ORRPTID),"~"),ORRPTID=$P($P(ORRPTID,";"),":")
S (ORSUB,ROOT)="ORDATA",ORIO="OR WINDOWS HFS",ORTEXT=$NA(^TMP(ORSUB,$J)),ORHANDLE="ORWRP"
K @ORTEXT
I '$$CHK() S @ORTEXT@(0)=ORY G PRINTWQ
S ORHFS=$$HFS^ORWRP(),ORWINDEV=1 ;Flag for printing to windows device
D HFSOPEN^ORWRP(ORHANDLE,ORHFS,"W")
I POP D Q
. I $D(ROOT) D SETITEM^ORWRP(ORTEXT,"ERROR: Unable to open HFS file")
D IOVAR^ORWRP(.ORIO,,,"P-WINHFS80")
N $ETRAP,$ESTACK
S $ETRAP="D ERR^ORWRP Q"
U IO
D DEQUE(.ORTEXT,1)
D HFSCLOSE^ORWRP(ORHANDLE,ORHFS)
PRINTWQ Q
; IHS/CIA/DKM - 1/23/2006 - Fixed problem with HFS data clobbering global data
PRINTWR(ORTEXT,ORDFN,ORRPTID,ORHANDS) ;Windows Remote device print
N ZTQUEUED,ORHFS,ORSUB,ROOT,ORIO,ORHANDLE,ORWINDEV
N IOM,IOSL,IOST,IOF,IOT,IOS,ORHSTAG,POP,ROOT
S ORHSTAG=$P($G(ORRPTID),"~",2),ORRPTID=$P($G(ORRPTID),"~"),ORRPTID=$P($P(ORRPTID,";"),":")
S (ORSUB,ROOT)="ORDATA",ORIO="OR WINDOWS HFS",ORTEXT=$NA(^TMP(ORSUB,$J)),ORHANDLE="ORWRP"
K @ORTEXT
S ORHFS=$$HFS^ORWRP(),ORWINDEV=1 ;Flag for printing to windows device
D HFSOPEN^ORWRP(ORHANDLE,ORHFS,"W")
I POP D Q
. I $D(ROOT) D SETITEM^ORWRP(ORTEXT,"ERROR: Unable to open HFS file")
D IOVAR^ORWRP(.ORIO,,,"P-WINHFS80")
N $ETRAP,$ESTACK
S $ETRAP="D ERR^ORWRP Q"
U IO
D DEQUE(.ORTEXT,1)
D HFSCLOSE^ORWRP(ORHANDLE,ORHFS)
Q
CHK() ; -- do checks for required data
N OROK,FALSE,TRUE,ORRPT,TXT,I,J,REPORT
S FALSE=0,TRUE=1,I="",REPORT=""
IF $G(ORIO)']"" S OROK=FALSE,ORY="1^No device selected." G CHKQ
IF '$L($G(ORRPTID)) S OROK=FALSE,ORY="2^No report specified." G CHKQ
; -- get report definition
F S I=$O(^ORD(101.24,"AC",I)) Q:I="" S J=0 F S J=$O(^ORD(101.24,"AC",I,J)) Q:'J D
. I $P($G(^ORD(101.24,J,0)),"^",2)=ORRPTID,$P(^(0),"^",8)="R" S REPORT=^(0)
I '$L(REPORT) S OROK=FALSE,ORY="2^Report not available." G CHKQ
S (TXT,ORRPT)=""
IF $P(REPORT,U,7)=1!($P(REPORT,U,7)=3),'$L($G(ORDTRNG)),'$G(ORALPHA) S OROK=FALSE,ORY="4^No date range specified." G CHKQ
IF $P(REPORT,U,4)=1,$G(ORHSTYPE)=0,'$O(ORCOMP(0)) S OROK=FALSE,ORY="10^No Adhoc components specified." G CHKQ
IF $P(REPORT,U,4)=1,'$G(ORHSTYPE),$P($G(ORHSTYPE),":")'=0 S OROK=FALSE,ORY="5^No health summary type specified." G CHKQ
IF $P(REPORT,U,4)=3,'$G(OREXAMID) S OROK=FALSE,ORY="7^No exam identified" G CHKQ
IF $P(REPORT,U,4)=4,'$L($G(OREXAMID)) S OROK=FALSE,ORY="9^No assessment identified" G CHKQ
IF $P(REPORT,U,4)=19,'$L($G(OREXAMID)) S OROK=FALSE,ORY="8^No procedure date identified" G CHKQ
IF '$D(^DPT(+$G(ORDFN),0)) S OROK=FALSE,ORY="6^Patient specified is not valid." G CHKQ
S OROK=TRUE
CHKQ Q OROK
;
; IHS/CIA/DKM - 1/23/2006: Added formal parameters.
; ROOT = Specify global root to use
; NOKILL = Leave data in global root
DEQUE(ROOT,NOKILL) ; -- logic to print queued report
; -- call build report logic
N I,J,X0,X1,X2,X4,SITE,RTN,ENT,ID,ORID,ORHEADER,ORI,ORX,ORVP,OUT,PENT,POUT,PRTN,MAX
S ORVP=ORDFN_";DPT(",POUT=""
S:'$D(ROOT) ROOT="ORDATA"
S I=0,(X1,X2,ORID,REPORT)="",SITE=$$SITE^VASITE,SITE=$P(SITE,"^",2)_";"_$P(SITE,"^",3)
F S I=$O(^ORD(101.24,"AC",I)) Q:I="" S J=0 F S J=$O(^ORD(101.24,"AC",I,J)) Q:'J D
. I $P($G(^ORD(101.24,J,0)),"^",2)=ORRPTID,$P(^(0),"^",8)="R" S X0=^(0),X2=$G(^(2)),ORID=$P(X2,"^",3),ORFHIE=$G(^(4)),X4=$P(ORFHIE,"^",2),ORFHIE=$P(ORFHIE,"^",3)
I '$L(X0) D NOTYET(.ROOT) Q
S RTN=$P(X0,"^",5),ENT=$P(X0,"^",6)
I '$L(RTN)!'$L(ENT) D NOTYET(.ROOT) Q
I '$L($T(@(ENT_"^"_RTN))) D NOTYET(.ROOT) Q
S PRTN=$P(X2,"^",7),PENT=$P(X2,"^",6)
I $G(ORALPHA) S X=ORALPHA-$G(OROMEGA) D
. I X<0 S X=X*(-1)
. I X4,X>X4 S:ORALPHA>OROMEGA OROMEGA=$$FMADD^XLFDT(ORALPHA,-X4) S:ORALPHA'>OROMEGA ORALPHA=$$FMADD^XLFDT(OROMEGA,-X4) S ORDTRNG=""
I X4,$G(ORDTRNG)>X4 S ORDTRNG=X4,ORALPHA=""
I $L($G(ORDTRNG)),'$G(ORALPHA) S ORALPHA=$$FMADD^XLFDT(DT,-ORDTRNG),OROMEGA=DT_".235959"
I $G(OROMEGA),$E(OROMEGA,8)'="." S OROMEGA=OROMEGA_".235959"
S ID=$G(ORHSTAG),$P(ID,";",5,8)=SITE_";"_$P(X2,"^",8)_";"_$P(X2,"^",9)
I $L($P($G(ORHSTAG),";",4)) S MAX=$P(ORHSTAG,";",4)
I $L($G(ORHSTYPE)) M ID=ORHSTYPE
I $L($G(OREXAMID)) M ID=OREXAMID
I $L(PRTN),$L(PENT),$L($T(@(PENT_"^"_PRTN))) S POUT=PENT_"^"_PRTN_"(.ROOT,ORDFN,.ID,.ORALPHA,.OROMEGA,.ORDTRNG,.REMOTE,.MAX,.ORFHIE)"
S OUT=ENT_"^"_RTN_"(.ROOT,ORDFN,.ID,.ORALPHA,.OROMEGA,.ORDTRNG,.REMOTE,.MAX,.ORFHIE)"
I '$O(ORHANDS(0)) D G OUT
. N ORY,PAGE
. I $L(POUT) D @POUT Q ;Go to non-standard print routine
. D @OUT
. Q:'$L(ROOT)!$G(NOKILL)
. S PAGE=1
. D HEAD^ORWRPP1(ORDFN,PAGE,ORID,$G(STATION))
. D HURL^ORWRPP1(.ROOT,ORDFN,ORID)
S ORI=0
F S ORI=$O(ORHANDS(ORI)) Q:'ORI S ORX=ORHANDS(ORI) D
. N ORY,PAGE,ORALPHA,OROMEGA
. D RTNDATA^XWBDRPC(.ORY,$P(ORX,"^",2))
. S:ORY="" ORY="ORY"
. S PAGE=1,ORALPHA=$P(ORX,"^",3),OROMEGA=$P(ORX,"^",4)
. D HEAD^ORWRPP1(ORDFN,PAGE,ORID,$P(ORX,"^"))
. D HURL^ORWRPP1(.ORY,ORDFN,ORID,1,$P(ORX,"^"))
OUT I $L($G(ROOT)),'$G(NOKILL) K @ROOT
Q
SITE(ORSTA) ;Print Station info
N X
I $G(ORSTA) S ORSTA=$$IEN^XUAF4(ORSTA)
S:'$L($G(ORSTA)) ORSTA=$G(DUZ(2))
S X="Report from: "_$$GET1^DIQ(4,+ORSTA,.01,"E")_" Station #"_$$GET1^DIQ(4,+ORSTA,99,"E")
W !?(IOM/2-($L(X)/2)),X
Q
NOTYET(ROOT) ; -- standard not available display text
D SETITEM(.ROOT,"Report not available at this time.")
Q
SETITEM(ROOT,X) ; -- set item in list
S @ROOT@($O(@ROOT@(9999),-1)+1)=X
Q
ORWRPP ; ALB/MJK - Background Report Print Driver ;18-Jun-2009 08:41;PLS
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,109,192,1002,1004,1010**;Dec 17, 1997;Build 47
+2 ; Modified - IHS/MSC/DKM - 06/18/09 - Line REMOTE+7, PRINT+9, and others
PRINT(ORY,ORIO,ORDFN,ORRPTID,ORHSTYPE,ORDTRNG,OREXAMID,ORCOMP,ORALPHA,OROMEGA) ; -- print report entry point
+1 ; RPC: ORWRP PRINT REPORT
+2 ; See RPC definition for details on input and output parameters
+3 NEW ORHSTAG
+4 SET ORHSTAG=$PIECE($GET(ORRPTID),"~",2)
SET ORRPTID=$PIECE($GET(ORRPTID),"~")
SET ORRPTID=$PIECE($PIECE(ORRPTID,";"),":")
+5 IF '$$CHK()
GOTO PRINTQ
+6 NEW ZTDTH,ZTRTN,ZTSK,ZTDESC,ZTSAVE,I,ZTIO
+7 SET ZTIO=ORIO
SET ZTDTH=$HOROLOG
+8 SET ZTDESC="Report Print"
+9 ;S ZTRTN="DEQUE^ORWRPP"
+10 ;IHS/CIA/DKM - 1/23/2006
SET ZTRTN="DEQUE^ORWRPP()"
+11 FOR I="ORDFN","ORRPTID","ORHSTYPE","ORDTRNG","OREXAMID","DUZ(","ORCOMP(","ORALPHA","OROMEGA","ORHSTAG"
SET ZTSAVE(I)=""
+12 DO ^%ZTLOAD
+13 IF $DATA(ZTSK)
Begin DoDot:1
+14 SET ORY="0^Report queued. (Task #"_ZTSK_")"
End DoDot:1
+15 IF '$TEST
Begin DoDot:1
+16 SET ORY="99^Task Rejected."
End DoDot:1
PRINTQ QUIT
REMOTE(ORY,ORIO,ORDFN,ORRPTID,ORHANDS) ;Print data for remote sites
+1 ; RPC: ORWRP PRINT REMOTE REPORT
+2 NEW ZTDTH,ZTRTN,ZTSK,ZTDESC,ZTSAVE,I,ORHSTAG,ZTIO
+3 SET ORHSTAG=$PIECE($GET(ORRPTID),"~",2)
SET ORRPTID=$PIECE($GET(ORRPTID),"~")
SET ORRPTID=$PIECE($PIECE(ORRPTID,";"),":")
+4 SET ZTIO=ORIO
SET ZTDTH=$HOROLOG
+5 SET ZTDESC="Remote Report Print"
+6 ;S ZTRTN="DEQUE^ORWRPP"
+7 ;IHS/CIA/DKM - 1/23/2006
SET ZTRTN="DEQUE^ORWRPP()"
+8 FOR I="ORDFN","ORRPTID","ORHANDS(","ORHSTAG"
SET ZTSAVE(I)=""
+9 DO ^%ZTLOAD
+10 IF $DATA(ZTSK)
Begin DoDot:1
+11 SET ORY="0^Report queued. (Task #"_ZTSK_")"
End DoDot:1
+12 IF '$TEST
Begin DoDot:1
+13 SET ORY="99^Task Rejected."
End DoDot:1
+14 QUIT
+15 ; IHS/CIA/DKM - 1/23/2006 - Fixed problem with HFS data clobbering global data
PRINTW(ORTEXT,ORDFN,ORRPTID,ORHSTYPE,ORDTRNG,OREXAMID,ORCOMP,ORALPHA,OROMEGA) ;Windows device print
+1 NEW ZTQUEUED,ORHFS,ORSUB,ROOT,ORIO,ORHANDLE,ORWINDEV
+2 NEW IOM,IOSL,IOST,IOF,IOT,IOS,ORHSTAG,POP
+3 SET ORHSTAG=$PIECE($GET(ORRPTID),"~",2)
SET ORRPTID=$PIECE($GET(ORRPTID),"~")
SET ORRPTID=$PIECE($PIECE(ORRPTID,";"),":")
+4 SET (ORSUB,ROOT)="ORDATA"
SET ORIO="OR WINDOWS HFS"
SET ORTEXT=$NAME(^TMP(ORSUB,$JOB))
SET ORHANDLE="ORWRP"
+5 KILL @ORTEXT
+6 IF '$$CHK()
SET @ORTEXT@(0)=ORY
GOTO PRINTWQ
+7 ;Flag for printing to windows device
SET ORHFS=$$HFS^ORWRP()
SET ORWINDEV=1
+8 DO HFSOPEN^ORWRP(ORHANDLE,ORHFS,"W")
+9 IF POP
Begin DoDot:1
+10 IF $DATA(ROOT)
DO SETITEM^ORWRP(ORTEXT,"ERROR: Unable to open HFS file")
End DoDot:1
QUIT
+11 DO IOVAR^ORWRP(.ORIO,,,"P-WINHFS80")
+12 NEW $ETRAP,$ESTACK
+13 SET $ETRAP="D ERR^ORWRP Q"
+14 USE IO
+15 DO DEQUE(.ORTEXT,1)
+16 DO HFSCLOSE^ORWRP(ORHANDLE,ORHFS)
PRINTWQ QUIT
+1 ; IHS/CIA/DKM - 1/23/2006 - Fixed problem with HFS data clobbering global data
PRINTWR(ORTEXT,ORDFN,ORRPTID,ORHANDS) ;Windows Remote device print
+1 NEW ZTQUEUED,ORHFS,ORSUB,ROOT,ORIO,ORHANDLE,ORWINDEV
+2 NEW IOM,IOSL,IOST,IOF,IOT,IOS,ORHSTAG,POP,ROOT
+3 SET ORHSTAG=$PIECE($GET(ORRPTID),"~",2)
SET ORRPTID=$PIECE($GET(ORRPTID),"~")
SET ORRPTID=$PIECE($PIECE(ORRPTID,";"),":")
+4 SET (ORSUB,ROOT)="ORDATA"
SET ORIO="OR WINDOWS HFS"
SET ORTEXT=$NAME(^TMP(ORSUB,$JOB))
SET ORHANDLE="ORWRP"
+5 KILL @ORTEXT
+6 ;Flag for printing to windows device
SET ORHFS=$$HFS^ORWRP()
SET ORWINDEV=1
+7 DO HFSOPEN^ORWRP(ORHANDLE,ORHFS,"W")
+8 IF POP
Begin DoDot:1
+9 IF $DATA(ROOT)
DO SETITEM^ORWRP(ORTEXT,"ERROR: Unable to open HFS file")
End DoDot:1
QUIT
+10 DO IOVAR^ORWRP(.ORIO,,,"P-WINHFS80")
+11 NEW $ETRAP,$ESTACK
+12 SET $ETRAP="D ERR^ORWRP Q"
+13 USE IO
+14 DO DEQUE(.ORTEXT,1)
+15 DO HFSCLOSE^ORWRP(ORHANDLE,ORHFS)
+16 QUIT
CHK() ; -- do checks for required data
+1 NEW OROK,FALSE,TRUE,ORRPT,TXT,I,J,REPORT
+2 SET FALSE=0
SET TRUE=1
SET I=""
SET REPORT=""
+3 IF $GET(ORIO)']""
SET OROK=FALSE
SET ORY="1^No device selected."
GOTO CHKQ
+4 IF '$LENGTH($GET(ORRPTID))
SET OROK=FALSE
SET ORY="2^No report specified."
GOTO CHKQ
+5 ; -- get report definition
+6 FOR
SET I=$ORDER(^ORD(101.24,"AC",I))
IF I=""
QUIT
SET J=0
FOR
SET J=$ORDER(^ORD(101.24,"AC",I,J))
IF 'J
QUIT
Begin DoDot:1
+7 IF $PIECE($GET(^ORD(101.24,J,0)),"^",2)=ORRPTID
IF $PIECE(^(0),"^",8)="R"
SET REPORT=^(0)
End DoDot:1
+8 IF '$LENGTH(REPORT)
SET OROK=FALSE
SET ORY="2^Report not available."
GOTO CHKQ
+9 SET (TXT,ORRPT)=""
+10 IF $PIECE(REPORT,U,7)=1!($PIECE(REPORT,U,7)=3)
IF '$LENGTH($GET(ORDTRNG))
IF '$GET(ORALPHA)
SET OROK=FALSE
SET ORY="4^No date range specified."
GOTO CHKQ
+11 IF $PIECE(REPORT,U,4)=1
IF $GET(ORHSTYPE)=0
IF '$ORDER(ORCOMP(0))
SET OROK=FALSE
SET ORY="10^No Adhoc components specified."
GOTO CHKQ
+12 IF $PIECE(REPORT,U,4)=1
IF '$GET(ORHSTYPE)
IF $PIECE($GET(ORHSTYPE),":")'=0
SET OROK=FALSE
SET ORY="5^No health summary type specified."
GOTO CHKQ
+13 IF $PIECE(REPORT,U,4)=3
IF '$GET(OREXAMID)
SET OROK=FALSE
SET ORY="7^No exam identified"
GOTO CHKQ
+14 IF $PIECE(REPORT,U,4)=4
IF '$LENGTH($GET(OREXAMID))
SET OROK=FALSE
SET ORY="9^No assessment identified"
GOTO CHKQ
+15 IF $PIECE(REPORT,U,4)=19
IF '$LENGTH($GET(OREXAMID))
SET OROK=FALSE
SET ORY="8^No procedure date identified"
GOTO CHKQ
+16 IF '$DATA(^DPT(+$GET(ORDFN),0))
SET OROK=FALSE
SET ORY="6^Patient specified is not valid."
GOTO CHKQ
+17 SET OROK=TRUE
CHKQ QUIT OROK
+1 ;
+2 ; IHS/CIA/DKM - 1/23/2006: Added formal parameters.
+3 ; ROOT = Specify global root to use
+4 ; NOKILL = Leave data in global root
DEQUE(ROOT,NOKILL) ; -- logic to print queued report
+1 ; -- call build report logic
+2 NEW I,J,X0,X1,X2,X4,SITE,RTN,ENT,ID,ORID,ORHEADER,ORI,ORX,ORVP,OUT,PENT,POUT,PRTN,MAX
+3 SET ORVP=ORDFN_";DPT("
SET POUT=""
+4 IF '$DATA(ROOT)
SET ROOT="ORDATA"
+5 SET I=0
SET (X1,X2,ORID,REPORT)=""
SET SITE=$$SITE^VASITE
SET SITE=$PIECE(SITE,"^",2)_";"_$PIECE(SITE,"^",3)
+6 FOR
SET I=$ORDER(^ORD(101.24,"AC",I))
IF I=""
QUIT
SET J=0
FOR
SET J=$ORDER(^ORD(101.24,"AC",I,J))
IF 'J
QUIT
Begin DoDot:1
+7 IF $PIECE($GET(^ORD(101.24,J,0)),"^",2)=ORRPTID
IF $PIECE(^(0),"^",8)="R"
SET X0=^(0)
SET X2=$GET(^(2))
SET ORID=$PIECE(X2,"^",3)
SET ORFHIE=$GET(^(4))
SET X4=$PIECE(ORFHIE,"^",2)
SET ORFHIE=$PIECE(ORFHIE,"^",3)
End DoDot:1
+8 IF '$LENGTH(X0)
DO NOTYET(.ROOT)
QUIT
+9 SET RTN=$PIECE(X0,"^",5)
SET ENT=$PIECE(X0,"^",6)
+10 IF '$LENGTH(RTN)!'$LENGTH(ENT)
DO NOTYET(.ROOT)
QUIT
+11 IF '$LENGTH($TEXT(@(ENT_"^"_RTN)))
DO NOTYET(.ROOT)
QUIT
+12 SET PRTN=$PIECE(X2,"^",7)
SET PENT=$PIECE(X2,"^",6)
+13 IF $GET(ORALPHA)
SET X=ORALPHA-$GET(OROMEGA)
Begin DoDot:1
+14 IF X<0
SET X=X*(-1)
+15 IF X4
IF X>X4
IF ORALPHA>OROMEGA
SET OROMEGA=$$FMADD^XLFDT(ORALPHA,-X4)
IF ORALPHA'>OROMEGA
SET ORALPHA=$$FMADD^XLFDT(OROMEGA,-X4)
SET ORDTRNG=""
End DoDot:1
+16 IF X4
IF $GET(ORDTRNG)>X4
SET ORDTRNG=X4
SET ORALPHA=""
+17 IF $LENGTH($GET(ORDTRNG))
IF '$GET(ORALPHA)
SET ORALPHA=$$FMADD^XLFDT(DT,-ORDTRNG)
SET OROMEGA=DT_".235959"
+18 IF $GET(OROMEGA)
IF $EXTRACT(OROMEGA,8)'="."
SET OROMEGA=OROMEGA_".235959"
+19 SET ID=$GET(ORHSTAG)
SET $PIECE(ID,";",5,8)=SITE_";"_$PIECE(X2,"^",8)_";"_$PIECE(X2,"^",9)
+20 IF $LENGTH($PIECE($GET(ORHSTAG),";",4))
SET MAX=$PIECE(ORHSTAG,";",4)
+21 IF $LENGTH($GET(ORHSTYPE))
MERGE ID=ORHSTYPE
+22 IF $LENGTH($GET(OREXAMID))
MERGE ID=OREXAMID
+23 IF $LENGTH(PRTN)
IF $LENGTH(PENT)
IF $LENGTH($TEXT(@(PENT_"^"_PRTN)))
SET POUT=PENT_"^"_PRTN_"(.ROOT,ORDFN,.ID,.ORALPHA,.OROMEGA,.ORDTRNG,.REMOTE,.MAX,.ORFHIE)"
+24 SET OUT=ENT_"^"_RTN_"(.ROOT,ORDFN,.ID,.ORALPHA,.OROMEGA,.ORDTRNG,.REMOTE,.MAX,.ORFHIE)"
+25 IF '$ORDER(ORHANDS(0))
Begin DoDot:1
+26 NEW ORY,PAGE
+27 ;Go to non-standard print routine
IF $LENGTH(POUT)
DO @POUT
QUIT
+28 DO @OUT
+29 IF '$LENGTH(ROOT)!$GET(NOKILL)
QUIT
+30 SET PAGE=1
+31 DO HEAD^ORWRPP1(ORDFN,PAGE,ORID,$GET(STATION))
+32 DO HURL^ORWRPP1(.ROOT,ORDFN,ORID)
End DoDot:1
GOTO OUT
+33 SET ORI=0
+34 FOR
SET ORI=$ORDER(ORHANDS(ORI))
IF 'ORI
QUIT
SET ORX=ORHANDS(ORI)
Begin DoDot:1
+35 NEW ORY,PAGE,ORALPHA,OROMEGA
+36 DO RTNDATA^XWBDRPC(.ORY,$PIECE(ORX,"^",2))
+37 IF ORY=""
SET ORY="ORY"
+38 SET PAGE=1
SET ORALPHA=$PIECE(ORX,"^",3)
SET OROMEGA=$PIECE(ORX,"^",4)
+39 DO HEAD^ORWRPP1(ORDFN,PAGE,ORID,$PIECE(ORX,"^"))
+40 DO HURL^ORWRPP1(.ORY,ORDFN,ORID,1,$PIECE(ORX,"^"))
End DoDot:1
OUT IF $LENGTH($GET(ROOT))
IF '$GET(NOKILL)
KILL @ROOT
+1 QUIT
SITE(ORSTA) ;Print Station info
+1 NEW X
+2 IF $GET(ORSTA)
SET ORSTA=$$IEN^XUAF4(ORSTA)
+3 IF '$LENGTH($GET(ORSTA))
SET ORSTA=$GET(DUZ(2))
+4 SET X="Report from: "_$$GET1^DIQ(4,+ORSTA,.01,"E")_" Station #"_$$GET1^DIQ(4,+ORSTA,99,"E")
+5 WRITE !?(IOM/2-($LENGTH(X)/2)),X
+6 QUIT
NOTYET(ROOT) ; -- standard not available display text
+1 DO SETITEM(.ROOT,"Report not available at this time.")
+2 QUIT
SETITEM(ROOT,X) ; -- set item in list
+1 SET @ROOT@($ORDER(@ROOT@(9999),-1)+1)=X
+2 QUIT
