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

ORWRP.m

Go to the documentation of this file.
  1. ORWRP ; ALB/MJK,dcm Report Calls ;Sep 15, 2020@09:01:07
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**1,10,85,109,132,160,194,227,215,262,243,280,377,498**;Dec 17, 1997;Build 38
  1. ;
  1. LABLIST(LST) ; -- report list for labs tab
  1. ; RPC: ORWRP LAB REPORT LIST
  1. N I,J,X,X0,X2,CNT,EOF,IFN,ROOT,RPC,ORLIST,HEAD
  1. S EOF="$$END",ROOT=$NA(LST),(CNT,I)=0
  1. D SETITEM(ROOT,"[LAB REPORT LIST]")
  1. D GETLST^XPAR(.ORLIST,"ALL","ORWRP REPORT LAB LIST")
  1. F S I=$O(ORLIST(I)) Q:'I Q:'$D(^ORD(101.24,$P(ORLIST(I),"^",2),0)) S X0=^(0),X2=$G(^(2)) D
  1. . Q:$P(X0,"^",12)="L"
  1. . S RPC=$$GET1^DIQ(8994,+$P(X0,"^",13),.01),IFN=ORLIST(I),HEAD=$P(X0,"^")
  1. . I $L($P(X2,"^",3)) S HEAD=$P(X2,"^",3)
  1. . S X=$P(X0,"^",2)_"^"_HEAD_"^"_$P(X0,"^",3)_"^"_$P(X0,"^",12)_"^"_$P(X0,"^",7)_"^"_RPC_"^"_IFN
  1. . D SETITEM(.ROOT,X)
  1. D SETITEM(.ROOT,"$$END")
  1. Q
  1. LIST(LST) ; -- report lists for reports tab
  1. ; RPC: ORWRP REPORT LIST
  1. N EOF,ROOT
  1. S EOF="$$END",ROOT=$NA(LST)
  1. K @ROOT
  1. D GETRPTS(.ROOT,.EOF) ; -report list
  1. D GETHS(.ROOT,.EOF) ; -health summary types
  1. D GETDT(.ROOT,.EOF) ; -date ranges
  1. Q
  1. GETCOL(ROOT,IFN) ; -- get Column headers for ListView
  1. N I,J,X,VAL
  1. Q:'$G(IFN)
  1. S I=0,ROOT=$NA(ROOT)
  1. F S I=$O(^ORD(101.24,IFN,3,"C",I)) Q:'I D
  1. . S VAL=$$GET^XPAR(DUZ_";VA(200,","ORWCH COLUMNS REPORTS",IFN,"I"),J=0
  1. . F S J=$O(^ORD(101.24,IFN,3,"C",I,J)) Q:'J I $D(^ORD(101.24,IFN,3,J)) S X=^(J,0) D
  1. .. I $L(VAL),$P(VAL,",",I) S $P(X,"^",10)=$P(VAL,",",I)
  1. .. D SETITEM(.ROOT,X)
  1. Q
  1. GETRPTS(ROOT,EOF) ; -- get report list
  1. N I,J,X,X0,X2,CNT,IFN,ORLIST,HEAD
  1. D SETITEM(.ROOT,"[REPORT LIST]"),GETLST^XPAR(.ORLIST,"ALL","ORWRP REPORT LIST")
  1. S (CNT,I)=0
  1. F S I=$O(ORLIST(I)) Q:'I Q:'$D(^ORD(101.24,$P(ORLIST(I),"^",2),0)) S X0=^(0),X2=$G(^(2)) D
  1. . Q:$P(X0,"^",12)="L"
  1. . S RPC=$$GET1^DIQ(8994,+$P(X0,"^",13),.01),IFN=ORLIST(I),HEAD=$P(X0,"^")
  1. . I $L($P(X2,"^",3)) S HEAD=$P(X2,"^",3)
  1. . S X=$P(X0,"^",2)_"^"_HEAD_"^"_$P(X0,"^",4)_"^"_$P(X0,"^",19)_";"_$P(X0,"^",20)_"^"_$P(X0,"^",6)_"^"_$P(X0,"^",5)_"^"_$P(X0,"^",3)_"^"_$P(X0,"^",12)_"^"_$P(X0,"^",7)_"^"_RPC_"^"_IFN
  1. . D SETITEM(.ROOT,X)
  1. D SETITEM(.ROOT,"$$END")
  1. Q
  1. GETHS(ROOT,EOF) ; --get health summary types
  1. N C,I,IFN,ORHSPARM,ORHSROOT,ORERR,X,T
  1. K ^TMP("ORHSPARM",$J)
  1. S ORHSROOT="^TMP(""ORHSPARM"",$J)"
  1. I $$GET^XPAR("ALL","ORWRP HEALTH SUMMARY LIST ALL",1) S I="",C=0 D
  1. . F S I=$O(^GMT(142,"B",I)) Q:I="" S IFN=$O(^(I,0)) Q:'IFN D
  1. .. S X=$G(^GMT(142,IFN,0)) Q:'$L(X)
  1. .. S T=$G(^GMT(142,IFN,"T")),C=C+1,@ORHSROOT@(C)=IFN_"^"_$S($L(T):T,1:$P(X,"^"))_"^^^^^1"
  1. .. I I="GMTS HS ADHOC OPTION" S @ORHSROOT@(C)="0^GMTS Adhoc Report"
  1. I '$$GET^XPAR("ALL","ORWRP HEALTH SUMMARY LIST ALL",1) D
  1. . D:$L($T(GETLIST^GMTSXAL)) GETLIST^GMTSXAL($NA(@ORHSROOT),$G(DUZ),1,.ORERR)
  1. . Q:$G(ORERR)
  1. . S I=0 F S I=$O(@ORHSROOT@(I)) Q:'I S @ORHSROOT@(I)=@ORHSROOT@(I)_"^^^^^1" I $P(@ORHSROOT@(I),"^",2)="GMTS HS ADHOC OPTION" S @ORHSROOT@(I)="0^Adhoc Report"
  1. D SETITEM(.ROOT,"[HEALTH SUMMARY TYPES]")
  1. S I=0 F S I=$O(@ORHSROOT@(I)) Q:'I D SETITEM(.ROOT,"h"_@ORHSROOT@(I))
  1. D SETITEM(.ROOT,EOF)
  1. Q
  1. GETDT(ROOT,EOF) ; -- get date range choices
  1. N I,X
  1. D SETITEM(.ROOT,"[DATE RANGES]")
  1. F I=2:1 S X=$P($T(DTLIST+I),";",3) Q:X=EOF D SETITEM(.ROOT,"d"_X)
  1. Q
  1. DTLIST ; -- list of date ranges
  1. ;<number of days>^ <display text>
  1. ;;S^Date Range...
  1. ;;0^Today
  1. ;;7^One Week
  1. ;;30^One Month
  1. ;;180^Six Months
  1. ;;365^One Year
  1. ;;732^Two Year
  1. ;;40000^All Results
  1. ;;$$END
  1. ;
  1. SETITEM(ROOT,X) ; -- set item in list
  1. S @ROOT@($O(@ROOT@(9999),-1)+1)=X
  1. Q
  1. RPT(ROOT,DFN,RPTID,HSTYPE,DTRANGE,EXAMID,ALPHA,OMEGA) ; -- return report text
  1. ;ROOT=Output in ^TMP("ORDATA",$J)
  1. ;DFN=Patient DFN ; ICN for remote sites
  1. ;RPTID=Unique report ID_";"_Remote ID_"~"_HSComponent for listview (ent;rtn;0;MaxOcc) or text (ent;rtn;#component;MaxOcc)
  1. ;HSTYPE=Health Sum Type
  1. ;DTRANGE=# days back from today
  1. ;EXAMID=Rad exam ID
  1. ;ALPHA=Start date
  1. ;OMEGA=End date
  1. ; RPC: ORWRP REPORT TEXT
  1. ;
  1. N X,X0,X2,X4,I,J,ENT,RTN,ID,REMOTE,GO,OUT,MAX,SITE,ORFHIE,%ZIS,HSTAG,DIRECT,TAB,ORRPTIEN,ORTIMOCC
  1. K ^TMP("ORDATA",$J)
  1. S TAB="R"
  1. I $E(RPTID,1,2)="L:" S TAB="L",RPTID=$P(RPTID,":",2,999) ;an ID beginning with "L:" forces TAB to LAB - "L:" added in GUI code
  1. S HSTAG=$P($G(RPTID),"~",2),RPTID=$P($G(RPTID),"~"),ROOT=$NA(^TMP("ORDATA",$J,1)),REMOTE=+$P(RPTID,";",2),RPTID=$P($P(RPTID,";"),":")
  1. S ORRPTIEN=""
  1. I 'REMOTE S DFN=+DFN ;DFN = DFN;ICN for remote calls
  1. S I=0,X0="",X2="",X4="",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)=RPTID,$P(^ORD(101.24,J,0),"^",8)=TAB D
  1. . . S X0=^ORD(101.24,J,0)
  1. . . S X2=$G(^ORD(101.24,J,2))
  1. . . S ORFHIE=$G(^ORD(101.24,J,4))
  1. . . S DIRECT=$P(ORFHIE,"^",4)
  1. . . S X4=$P(ORFHIE,"^",2)
  1. . . S ORFHIE=$P(ORFHIE,"^",3)
  1. . . S ORRPTIEN=J
  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. ;I $G(ALPHA) S X=ALPHA-$G(OMEGA) D ;jeh 243
  1. I $G(ALPHA) D
  1. . N X1,X2
  1. . S X=ALPHA
  1. . S X1=ALPHA,X2=$G(OMEGA) D:X2 ^%DTC ;X returned, # of days diff
  1. . I X<0 S X=X*(-1)
  1. . I X4,X>X4 S:ALPHA>OMEGA OMEGA=$$FMADD^XLFDT(ALPHA,-X4) S:ALPHA'>OMEGA ALPHA=$$FMADD^XLFDT(OMEGA,-X4) S DTRANGE=""
  1. I X4,$G(DTRANGE)>X4 S DTRANGE=X4,ALPHA=""
  1. I $L($G(DTRANGE)),'$G(ALPHA) S ALPHA=$$FMADD^XLFDT(DT,-DTRANGE),OMEGA=DT_".235959"
  1. I $G(OMEGA),$E(OMEGA,8)'="." S OMEGA=OMEGA_".235959"
  1. S ID=$G(HSTAG),$P(ID,";",5,10)=SITE_";"_$P(X2,"^",8)_";"_$P(X2,"^",9)_";"_RPTID_";"_$G(DIRECT) ;HDRHX CHANGE
  1. I $L($P($G(HSTAG),";",4)) S MAX=$P(HSTAG,";",4)
  1. ; If HSWPComponent type report, and Max not passed in from GUI, use Max defined in params (GETINDV^ORWTPD)
  1. ; (temp p498 fix - until can be fixed properly in v32)
  1. I $P(X0,U,4)=6,$G(MAX)'>0 D
  1. . I 'ORRPTIEN Q
  1. . S ORTIMOCC=""
  1. . D GETINDV^ORWTPD(.ORTIMOCC,ORRPTIEN)
  1. . I $P(ORTIMOCC,";",3)>0 S MAX=$P(ORTIMOCC,";",3)
  1. I $L($G(HSTYPE)) M ID=HSTYPE
  1. I $L($G(EXAMID)) M ID=EXAMID
  1. S OUT=ENT_"^"_RTN_"(.ROOT,DFN,.ID,.ALPHA,.OMEGA,.DTRANGE,.REMOTE,.MAX,.ORFHIE)"
  1. I REMOTE S GO=0 D Q:'GO
  1. . I '$L($T(GETDFN^MPIF001)) D SETITEM(.ROOT,"MPI routines missing on remote system ("_SITE_")") S GO=0 Q
  1. . S ICN=+$P(DFN,";",2),DFN=+$$GETDFN^MPIF001(ICN)
  1. . I DFN<0 D SETITEM(.ROOT,"Patient not found on remote system ("_SITE_")") S GO=0 Q
  1. . S GO=+$P(X0,"^",3)
  1. . I 'GO D SETITEM(.ROOT,"Remote access not available for this report ("_SITE_")")
  1. S %ZIS="0N"
  1. D @OUT
  1. Q
  1. NOTYET(ROOT) ; -- not available
  1. D SETITEM(.ROOT,"Report not available at this time.")
  1. Q
  1. START(RM,GOTO,ORIOSL) ;
  1. ;RM=Right margin
  1. N ZTQUEUED,ORHFS,ORSUB,ORIO,ORHANDLE,IOM,IOSL,IOST,IOF,IOT,IOS
  1. S ORHFS=$$HFS(),ORSUB="ORDATA",ORHANDLE="ORWRP"
  1. D HFSOPEN(ORHANDLE,ORHFS,"W")
  1. I POP D Q
  1. . I $D(ROOT) D SETITEM(.ROOT,"ERROR: Unable to open HFS file")
  1. D IOVAR(.ORIO,.RM,.ORIOSL)
  1. N $ETRAP,$ESTACK
  1. S $ETRAP="D ERR^ORWRP Q"
  1. U IO
  1. D @GOTO
  1. D HFSCLOSE(ORHANDLE,ORHFS)
  1. Q
  1. ERR ;Error trap
  1. S $ETRAP="D UNWIND^ORWRP Q"
  1. N %ZIS
  1. S %ZIS="0N"
  1. D @^%ZOSF("ERRTN") ;file error
  1. I $D(ORHANDLE) D CLOSE^%ZISH(ORHANDLE)
  1. I $D(ORHFS) D
  1. . N ORARR,OROK
  1. . S ORARR(ORHFS)="",OROK=$$DEL^%ZISH("",$NA(ORARR)) ;delete HFS file
  1. S $ECODE=",UOR69 error during CPRS report build,"
  1. Q
  1. UNWIND ;Unwind Error stack
  1. Q:$ESTACK>1 ;pop stack
  1. ;
  1. Q
  1. HFS() ; -- get hfs file name
  1. N H
  1. S H=$H
  1. Q "ORU_"_$J_"_"_$P(H,",")_"_"_$P(H,",",2)_".DAT"
  1. HFSOPEN(HANDLE,ORHFS,ORMODE) ;
  1. D OPEN^%ZISH(HANDLE,,ORHFS,$G(ORMODE,"W")) Q:POP
  1. Q
  1. IOVAR(ORIO,ORRM,ORIOSL,ORIOST,ORIOF,ORIOT) ;Setup IO variables based on IO Device
  1. N IFN,IFN1
  1. S ORIO=$G(ORIO,"OR WORKSTATION"),ION=ORIO,IOM=$G(ORRM,80),IOSL=$G(ORIOSL,62),IOST=$G(ORIOST,"P-OTHER"),IOF=$G(ORIOF,""""""),IOT=$G(ORIOT,"HFS")
  1. I $O(^%ZIS(1,"B",ORIO,0)) S IFN=$O(^(0)),IOS=IFN
  1. I $D(^%ZIS(1,IFN,0)) S IOST(0)=+$G(^("SUBTYPE")),IOT=$G(ORIOT,^("TYPE")),IOST=$G(ORIOST,$P($G(^%ZIS(2,IOST(0),0),IOST),"^"))
  1. I $O(^%ZIS(2,"B",IOST,0)) S IFN=$O(^(0)) I IFN S IOST(0)=IFN,IFN1=$G(^%ZIS(2,IFN,1)),IOM=$G(ORRM,$P(IFN1,"^")),IOF=$G(ORIOF,$P(IFN1,"^",2)),IOSL=$G(ORIOSL,$P(IFN1,"^",3))
  1. Q
  1. HFSCLOSE(HANDLE,ORHFS) ;Close HFS and unload data
  1. N ORDEL,X,%ZIS
  1. S %ZIS="0N"
  1. I IO[ORHFS D CLOSE^%ZISH(HANDLE)
  1. S ROOT=$NA(^TMP(ORSUB,$J,1)),ORDEL(ORHFS)=""
  1. K @ROOT
  1. S X=$$FTG^%ZISH(,ORHFS,$NA(@ROOT@(1)),4)
  1. D STRIP
  1. S X=$$DEL^%ZISH(,$NA(ORDEL))
  1. Q
  1. USEHFS ; -- use host file to build global array
  1. N OROK,SECTION
  1. S SECTION=0
  1. D INIT
  1. S OROK=$$FTG^%ZISH(,ORHFS,$NA(@ROOT@(1)),4) I 'OROK Q
  1. D STRIP
  1. N ORARR S ORARR(ORHFS)=""
  1. S OROK=$$DEL^%ZISH("",$NA(ORARR))
  1. Q
  1. INIT ; -- initialize counts and global section
  1. S (INC,CNT)=0,SECTION=SECTION+1,ROOT=$NA(^TMP(ORSUB,$J,SECTION))
  1. K @ROOT
  1. Q
  1. FINAL ; -- set 'x of y' for each section CALLED FROM ^ORWLR
  1. N I
  1. F I=1:1:SECTION S ^TMP(ORSUB,$J,I,.1)=I_U_SECTION
  1. Q
  1. STRIP ; -- strip off control chars
  1. N I,X
  1. S I=0 F S I=$O(@ROOT@(I)) Q:'I S X=^(I) D
  1. . I X[$C(8) D ;BS
  1. .. I $L(X,$C(8))=$L(X,$C(95)) S (X,@ROOT@(I))=$TR(X,$C(8,95),"") Q ;BS & _
  1. .. S (X,@ROOT@(I))=$TR(X,$C(8),"")
  1. . I X[$C(7)!(X[$C(12)) S @ROOT@(I)=$TR(X,$C(7,12),"") ;BEL or FF
  1. Q
  1. WINDFLT(ORY) ;Windows printer as default?
  1. S ORY=+$$GET^XPAR("ALL","ORWDP WINPRINT DEFAULT")
  1. Q
  1. GETDFPRT(Y,ORUSER,ORLOC) ; Returns default printer for user
  1. N IEN,X0,ENT
  1. S ENT="ALL"
  1. I $G(ORLOC) S ORLOC=+ORLOC_";SC(",ENT=ENT_"^"_ORLOC
  1. I +$$GET^XPAR(ENT,"ORWDP WINPRINT DEFAULT") S Y="WIN;Windows Printer" Q
  1. S IEN=$$GET^XPAR(ENT,"ORWDP DEFAULT PRINTER",1) Q:+IEN=0
  1. Q:'$D(^%ZIS(1,IEN,0)) S X0=^(0)
  1. S Y=IEN_";"_$P(X0,U)
  1. Q
  1. SAVDFPRT(Y,ORDEV) ; Save new default printer for user
  1. N ORPAR,ORERR,ORWINDEF
  1. Q:$L(ORDEV)=0
  1. ; Reset Windows printer default to True/False
  1. S ORPAR="ORWDP WINPRINT DEFAULT"
  1. I ORDEV="WIN" S ORWINDEF="Y"
  1. E S ORWINDEF="N"
  1. I $$GET^XPAR(DUZ_";VA(200,",ORPAR,1)'="" D CHG^XPAR(DUZ_";VA(200,",ORPAR,1,ORWINDEF,.ORERR)
  1. E D ADD^XPAR(DUZ_";VA(200,",ORPAR,1,ORWINDEF,.ORERR)
  1. Q:ORDEV="WIN"
  1. ; If not Windows printer selected, save VistA default printer
  1. S ORPAR="ORWDP DEFAULT PRINTER",ORDEV="`"_ORDEV
  1. I $$GET^XPAR(DUZ_";VA(200,",ORPAR,1)'="" D CHG^XPAR(DUZ_";VA(200,",ORPAR,1,ORDEV,.ORERR)
  1. E D ADD^XPAR(DUZ_";VA(200,",ORPAR,1,ORDEV,.ORERR)
  1. Q