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

ORWRPP.m

Go to the documentation of this file.
  1. ORWRPP ; ALB/MJK - Background Report Print Driver ;01/04/18 10:37
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,109,192,332,449,405**;Dec 17, 1997;Build 211
  1. ;
  1. ;
  1. PRINT(ORY,ORIO,ORDFN,ORRPTID,ORHSTYPE,ORDTRNG,OREXAMID,ORCOMP,ORALPHA,OROMEGA) ; -- print report entry point
  1. ; RPC: ORWRP PRINT REPORT
  1. ; See RPC definition for details on input and output parameters
  1. N ORHSTAG
  1. S ORHSTAG=$P($G(ORRPTID),"~",2),ORRPTID=$P($G(ORRPTID),"~"),ORRPTID=$P($P(ORRPTID,";"),":")
  1. IF '$$CHK() G PRINTQ
  1. N ZTDTH,ZTRTN,ZTSK,ZTDESC,ZTSAVE,I,ZTIO
  1. S ZTIO=ORIO,ZTDTH=$H
  1. S ZTDESC="Report Print"
  1. S ZTRTN="DEQUE^ORWRPP"
  1. F I="ORDFN","ORRPTID","ORHSTYPE","ORDTRNG","OREXAMID","DUZ(","ORCOMP(","ORALPHA","OROMEGA","ORHSTAG" S ZTSAVE(I)=""
  1. D ^%ZTLOAD
  1. I $D(ZTSK) D
  1. . S ORY="0^Report queued. (Task #"_ZTSK_")"
  1. E D
  1. . S ORY="99^Task Rejected."
  1. PRINTQ Q
  1. REMOTE(ORY,ORIO,ORDFN,ORRPTID,ORHANDS) ;Print data for remote sites
  1. ; RPC: ORWRP PRINT REMOTE REPORT
  1. N ZTDTH,ZTRTN,ZTSK,ZTDESC,ZTSAVE,I,ORHSTAG,ZTIO
  1. S ORHSTAG=$P($G(ORRPTID),"~",2),ORRPTID=$P($G(ORRPTID),"~"),ORRPTID=$P($P(ORRPTID,";"),":")
  1. S ZTIO=ORIO,ZTDTH=$H
  1. S ZTDESC="Remote Report Print"
  1. S ZTRTN="DEQUE^ORWRPP"
  1. F I="ORDFN","ORRPTID","ORHANDS(","ORHSTAG" S ZTSAVE(I)=""
  1. D ^%ZTLOAD
  1. I $D(ZTSK) D
  1. . S ORY="0^Report queued. (Task #"_ZTSK_")"
  1. E D
  1. . S ORY="99^Task Rejected."
  1. Q
  1. PRINTW(ORTEXT,ORDFN,ORRPTID,ORHSTYPE,ORDTRNG,OREXAMID,ORCOMP,ORALPHA,OROMEGA) ;Windows device print
  1. N ZTQUEUED,ORHFS,ORSUB,ROOT,ORIO,ORHANDLE,ORWINDEV
  1. N IOM,IOSL,IOST,IOF,IOT,IOS,ORHSTAG,POP
  1. S ORHSTAG=$P($G(ORRPTID),"~",2),ORRPTID=$P($G(ORRPTID),"~"),ORRPTID=$P($P(ORRPTID,";"),":")
  1. S (ORSUB,ROOT)="ORDATA",ORIO="OR WINDOWS HFS",ORTEXT=$NA(^TMP(ORSUB,$J,1)),ORHANDLE="ORWRP"
  1. I '$$CHK() S @ORTEXT@(0)=ORY G PRINTWQ
  1. S ORHFS=$$HFS^ORWRP(),ORWINDEV=1 ;Flag for printing to windows device
  1. D HFSOPEN^ORWRP(ORHANDLE,ORHFS,"W")
  1. I POP D Q
  1. . I $D(ROOT) D SETITEM^ORWRP(.ROOT,"ERROR: Unable to open HFS file")
  1. D IOVAR^ORWRP(.ORIO,,,"P-WINHFS80")
  1. N $ETRAP,$ESTACK
  1. S $ETRAP="D ERR^ORWRP Q"
  1. U IO
  1. D DEQUE
  1. D HFSCLOSE^ORWRP(ORHANDLE,ORHFS)
  1. PRINTWQ Q
  1. PRINTWR(ORTEXT,ORDFN,ORRPTID,ORHANDS) ;Windows Remote device print
  1. N ZTQUEUED,ORHFS,ORSUB,ROOT,ORIO,ORHANDLE,ORWINDEV
  1. N IOM,IOSL,IOST,IOF,IOT,IOS,ORHSTAG,POP
  1. S ORHSTAG=$P($G(ORRPTID),"~",2),ORRPTID=$P($G(ORRPTID),"~"),ORRPTID=$P($P(ORRPTID,";"),":")
  1. S (ORSUB,ROOT)="ORDATA",ORIO="OR WINDOWS HFS",ORTEXT=$NA(^TMP(ORSUB,$J,1)),ORHANDLE="ORWRP"
  1. S ORHFS=$$HFS^ORWRP(),ORWINDEV=1 ;Flag for printing to windows device
  1. D HFSOPEN^ORWRP(ORHANDLE,ORHFS,"W")
  1. I POP D Q
  1. . I $D(ROOT) D SETITEM^ORWRP(.ROOT,"ERROR: Unable to open HFS file")
  1. D IOVAR^ORWRP(.ORIO,,,"P-WINHFS80")
  1. N $ETRAP,$ESTACK
  1. S $ETRAP="D ERR^ORWRP Q"
  1. U IO
  1. D DEQUE
  1. D HFSCLOSE^ORWRP(ORHANDLE,ORHFS)
  1. Q
  1. CHK() ; -- do checks for required data
  1. N OROK,FALSE,TRUE,ORRPT,TXT,I,J,REPORT
  1. S FALSE=0,TRUE=1,I="",REPORT=""
  1. IF $G(ORIO)']"" S OROK=FALSE,ORY="1^No device selected." G CHKQ
  1. IF '$L($G(ORRPTID)) S OROK=FALSE,ORY="2^No report specified." G CHKQ
  1. ; -- get report definition
  1. 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
  1. . I $P($G(^ORD(101.24,J,0)),"^",2)=ORRPTID,$P(^(0),"^",8)="R" S REPORT=^(0)
  1. I '$L(REPORT) S OROK=FALSE,ORY="2^Report not available." G CHKQ
  1. S (TXT,ORRPT)=""
  1. 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
  1. IF $P(REPORT,U,4)=1,$G(ORHSTYPE)=0,'$O(ORCOMP(0)) S OROK=FALSE,ORY="10^No Adhoc components specified." G CHKQ
  1. IF $P(REPORT,U,4)=1,'$G(ORHSTYPE),$P($G(ORHSTYPE),":")'=0 S OROK=FALSE,ORY="5^No health summary type specified." G CHKQ
  1. IF $P(REPORT,U,4)=3,'$G(OREXAMID) S OROK=FALSE,ORY="7^No exam identified" G CHKQ
  1. IF $P(REPORT,U,4)=4,'$L($G(OREXAMID)) S OROK=FALSE,ORY="9^No assessment identified" G CHKQ
  1. IF $P(REPORT,U,4)=19,'$L($G(OREXAMID)) S OROK=FALSE,ORY="8^No procedure date identified" G CHKQ
  1. IF '$D(^DPT(+$G(ORDFN),0)) S OROK=FALSE,ORY="6^Patient specified is not valid." G CHKQ
  1. S OROK=TRUE
  1. CHKQ Q OROK
  1. ;
  1. DEQUE ; -- logic to print queued report
  1. ; -- call build report logic
  1. N I,J,X0,X1,X2,X4,SITE,RTN,ENT,ID,ORID,ORHEADER,ORI,ORX,ORVP,OUT,PENT,POUT,PRTN,ROOT,MAX,ORPRTING
  1. S ORVP=ORDFN_";DPT(",ROOT="ORDATA",POUT="",ORPRTING=1
  1. S I=0,(X1,X2,ORID,REPORT)="",SITE=$$SITE^VASITE,SITE=$P(SITE,"^",2)_";"_$P(SITE,"^",3)
  1. 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
  1. . 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)
  1. I '$L(X0) D NOTYET(.ROOT) Q
  1. S RTN=$P(X0,"^",5),ENT=$P(X0,"^",6)
  1. I '$L(RTN)!'$L(ENT) D NOTYET(.ROOT) Q
  1. I '$L($T(@(ENT_"^"_RTN))) D NOTYET(.ROOT) Q
  1. S PRTN=$P(X2,"^",7),PENT=$P(X2,"^",6)
  1. I $G(ORALPHA) S X=$$FMDIFF^XLFDT(ORALPHA,$G(OROMEGA)) D
  1. . I X<0 S X=X*(-1)
  1. . I X4,X>X4 S:ORALPHA>OROMEGA OROMEGA=$$FMADD^XLFDT(ORALPHA,-X4) S:ORALPHA'>OROMEGA ORALPHA=$$FMADD^XLFDT(OROMEGA,-X4) S ORDTRNG=""
  1. I X4,$G(ORDTRNG)>X4 S ORDTRNG=X4,ORALPHA=""
  1. I $L($G(ORDTRNG)),'$G(ORALPHA) S ORALPHA=$$FMADD^XLFDT(DT,-ORDTRNG),OROMEGA=DT_".235959"
  1. I $G(OROMEGA),$E(OROMEGA,8)'="." S OROMEGA=OROMEGA_".235959"
  1. S ID=$G(ORHSTAG),$P(ID,";",5,8)=SITE_";"_$P(X2,"^",8)_";"_$P(X2,"^",9)
  1. I $L($P($G(ORHSTAG),";",4)) S MAX=$P(ORHSTAG,";",4)
  1. I $L($G(ORHSTYPE)) M ID=ORHSTYPE
  1. I $L($G(OREXAMID)) M ID=OREXAMID
  1. I $L(PRTN),$L(PENT),$L($T(@(PENT_"^"_PRTN))) S POUT=PENT_"^"_PRTN_"(.ROOT,ORDFN,.ID,.ORALPHA,.OROMEGA,.ORDTRNG,.REMOTE,.MAX,.ORFHIE)"
  1. S OUT=ENT_"^"_RTN_"(.ROOT,ORDFN,.ID,.ORALPHA,.OROMEGA,.ORDTRNG,.REMOTE,.MAX,.ORFHIE)"
  1. I '$O(ORHANDS(0)) D G OUT
  1. . N ORY,PAGE
  1. . I $L(POUT) D @POUT Q ;Go to non-standard print routine
  1. . D @OUT
  1. . Q:'$L(ROOT)
  1. . S PAGE=1
  1. . D HEAD^ORWRPP1(ORDFN,PAGE,ORID,$G(STATION))
  1. . D HURL^ORWRPP1(.ROOT,ORDFN,ORID)
  1. S ORI=0
  1. F S ORI=$O(ORHANDS(ORI)) Q:'ORI S ORX=ORHANDS(ORI) D
  1. . N ORY,PAGE,ORALPHA,OROMEGA
  1. . D RTNDATA^XWBDRPC(.ORY,$P(ORX,"^",2))
  1. . S:ORY="" ORY="ORY"
  1. . S PAGE=1,ORALPHA=$P(ORX,"^",3),OROMEGA=$P(ORX,"^",4)
  1. . D HEAD^ORWRPP1(ORDFN,PAGE,ORID,$P(ORX,"^"))
  1. . D HURL^ORWRPP1(.ORY,ORDFN,ORID,1,$P(ORX,"^"))
  1. OUT I $L($G(ROOT)) K @ROOT
  1. Q
  1. SITE(ORSTA) ;Print Station info
  1. N X
  1. I $G(ORSTA) S ORSTA=$$IEN^XUAF4(ORSTA)
  1. S:'$L($G(ORSTA)) ORSTA=$G(DUZ(2))
  1. S X="Report from: "_$$GET1^DIQ(4,+ORSTA,.01,"E")_" Station #"_$$GET1^DIQ(4,+ORSTA,99,"E")
  1. W !?(IOM/2-($L(X)/2)),X
  1. Q
  1. LRSITE(ORSTA) ;Print Station info
  1. N X,ORADD
  1. I $G(ORSTA) S ORSTA=$$IEN^XUAF4(ORSTA)
  1. S:'$L($G(ORSTA)) ORSTA=$G(DUZ(2))
  1. S X="Report from: "_$$GET1^DIQ(4,+ORSTA,.01,"E")_" Station #"_$$GET1^DIQ(4,+ORSTA,99,"E")
  1. W !?(IOM/2-($L(X)/2)),X
  1. S ORADD=$$PADD^XUAF4(+ORSTA)
  1. S ORADD=$P(ORADD,"^")_", "_$P(ORADD,"^",2)_", "_$P(ORADD,"^",3)_" "_$P(ORADD,"^",4)
  1. S ORADD=$E(ORADD,1,76)
  1. W !?(IOM/2-($L(ORADD)/2)),ORADD
  1. Q
  1. NOTYET(ROOT) ; -- standard not available display text
  1. D SETITEM(.ROOT,"Report not available at this time.")
  1. Q
  1. SETITEM(ROOT,X) ; -- set item in list
  1. S @ROOT@($O(@ROOT@(9999),-1)+1)=X
  1. Q