ORWRA ; ALB/MJK/REV/JDL -Imaging Calls ;8/6/02 1:30 [2/12/04 9:25am]
;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,109,135,132,148,154,141,160,149,190**;Dec 17, 1997
EXAMS(ROOT,DFN) ; Return imaging exams
; RPC: ORWRA IMAGING EXAMS
; See RPC definition for details on input and output parameters
D GET(0)
Q
EXAMS1(ROOT,DFN) ; Return imaging exams
; RPC: ORWRA IMAGING EXAMS1
; See RPC definition for details on input and output parameters
D GET(1)
Q
GET(GSITE) ;Get the data
N I,ID,RADATA,STRING,SITE,ORCX
N BEG,END,MAX,P1,P2
S RADATA=$NA(^TMP($J,"RAE1",DFN))
S ROOT=$NA(^TMP($J,"ORAEXAMS"))
S ORCX=1 ;show cancelled reports
K @RADATA,@ROOT
;
; -- set date range
D GETDEFG(.STRING)
S BEG=$P(STRING,U)
S END=$P(STRING,"^",2)
S MAX=$P(STRING,"^",3)
I GSITE="1" S MAX=MAX_"P"
D EN1^RAO7PC1(DFN,BEG,END,MAX,ORCX)
;
; -- reformat data array for rpc
S I=0,ID="",SITE=""
I $G(GSITE) S SITE=$$SITE^VASITE,SITE=$P(SITE,"^",2)_";"_$P(SITE,"^",3)_U
F S ID=$O(@RADATA@(ID)) Q:ID="" D
. S P1=$P($G(^TMP($J,"RAE1",DFN,ID,"CPRS")),U) ;The member of set indicator from Radiology
. S P2=$P($G(^TMP($J,"RAE1",DFN,ID,"CPRS")),U,2) ;The parent procedure name from Radiology
. S I=I+1
. S @ROOT@(I)=SITE_ID_U_(9999999.9999-ID)_U_@RADATA@(ID)_U_P1_U_P2
K @RADATA
Q
;
GETDEFG(Y) ; -- get default context settings for GUI imaging reports
N BEG,END,MAX
;if called from CAPRI, show all reports
D OP^XQCHK
I $P($G(XQOPT),"^",1)="DVBA CAPRI GUI" D
. S BEG=$$DT^ORCHTAB1("T-36500")
. S END=$$DT^ORCHTAB1("T")
. S MAX="9999"
. S Y=BEG_"^"_END_"^"_MAX
; if not CAPRI, use CPRS defaults
E D GETIMG^ORWTPD(.Y,"")
Q
GETDEF(Y) ; -- get default context settings for LM imaging reports
N BEG,CONTEXT,END,MAX
S CONTEXT=$$GET^XPAR("ALL","ORCH CONTEXT REPORTS")
S BEG=$$DT^ORCHTAB1($P(CONTEXT,";"))
S END=$$DT^ORCHTAB1($P(CONTEXT,";",2))
S MAX=$P(CONTEXT,";",5)
D OP^XQCHK
I $P($G(XQOPT),"^",1)="DVBA CAPRI GUI" D
.S BEG=$$DT^ORCHTAB1("T-36500")
.S END=$$DT^ORCHTAB1("T")
.S MAX="9999"
S Y=BEG_"^"_END_"^"_MAX
Q
;
RPT1(ROOT,DFN,ORID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ; -- return imaging report
D RPT(.ROOT,.DFN,.ORID,.ALPHA,.OMEGA,.DTRANGE,.REMOTE,.ORMAX,.ORFHIE)
Q
RPT(ROOT,DFN,ORID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ; -- return imaging report
; RPC: ORWRA REPORT TEXT
; See RPC definition for details on input and output parameters
; -- init locals and globals
N ID,LCNT,ORVP,EXAMDATE,CASENMBR
S RADATA=$NA(^TMP($J,"RAE3"))
S ROOT=$NA(^TMP("ORXPND",$J))
K @RADATA,@ROOT
;
; -- set up exam id and call to get report text
S ID=$TR(ORID,"-",U)
;
; -- set up counter and vp local for dfn for formating call
S LCNT=0,ORVP=DFN_";DPT("
D XRAYS^ORCXPND1
K @RADATA
Q
;
TEST ; -- test to get exam list
N I,ROOT,DFN
S DFN=16
D EXAMS1(.ROOT,DFN)
W !,"Root: ",ROOT
S I=0 F S I=$O(@ROOT@(I)) Q:'I W !,@ROOT@(I)
Q
;
TEST1 ; -- test to print reprt for first 3 exams
N ORI,ROOT,ROOT1,L,X,DFN
S DFN=16
D EXAMS1(.ROOT,DFN)
S ORI=0 F S ORI=$O(@ROOT@(ORI)) Q:'ORI D Q:ORI=3
. S X=@ROOT@(ORI)
. D RPT1(.ROOT1,DFN,$P(X,U))
. S L=0 F S L=$O(@ROOT1@(L)) Q:'L W !,@ROOT1@(L,0)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWRA 3243 printed Dec 13, 2024@02:37:14 Page 2
ORWRA ; ALB/MJK/REV/JDL -Imaging Calls ;8/6/02 1:30 [2/12/04 9:25am]
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,109,135,132,148,154,141,160,149,190**;Dec 17, 1997
EXAMS(ROOT,DFN) ; Return imaging exams
+1 ; RPC: ORWRA IMAGING EXAMS
+2 ; See RPC definition for details on input and output parameters
+3 DO GET(0)
+4 QUIT
EXAMS1(ROOT,DFN) ; Return imaging exams
+1 ; RPC: ORWRA IMAGING EXAMS1
+2 ; See RPC definition for details on input and output parameters
+3 DO GET(1)
+4 QUIT
GET(GSITE) ;Get the data
+1 NEW I,ID,RADATA,STRING,SITE,ORCX
+2 NEW BEG,END,MAX,P1,P2
+3 SET RADATA=$NAME(^TMP($JOB,"RAE1",DFN))
+4 SET ROOT=$NAME(^TMP($JOB,"ORAEXAMS"))
+5 ;show cancelled reports
SET ORCX=1
+6 KILL @RADATA,@ROOT
+7 ;
+8 ; -- set date range
+9 DO GETDEFG(.STRING)
+10 SET BEG=$PIECE(STRING,U)
+11 SET END=$PIECE(STRING,"^",2)
+12 SET MAX=$PIECE(STRING,"^",3)
+13 IF GSITE="1"
SET MAX=MAX_"P"
+14 DO EN1^RAO7PC1(DFN,BEG,END,MAX,ORCX)
+15 ;
+16 ; -- reformat data array for rpc
+17 SET I=0
SET ID=""
SET SITE=""
+18 IF $GET(GSITE)
SET SITE=$$SITE^VASITE
SET SITE=$PIECE(SITE,"^",2)_";"_$PIECE(SITE,"^",3)_U
+19 FOR
SET ID=$ORDER(@RADATA@(ID))
if ID=""
QUIT
Begin DoDot:1
+20 ;The member of set indicator from Radiology
SET P1=$PIECE($GET(^TMP($JOB,"RAE1",DFN,ID,"CPRS")),U)
+21 ;The parent procedure name from Radiology
SET P2=$PIECE($GET(^TMP($JOB,"RAE1",DFN,ID,"CPRS")),U,2)
+22 SET I=I+1
+23 SET @ROOT@(I)=SITE_ID_U_(9999999.9999-ID)_U_@RADATA@(ID)_U_P1_U_P2
End DoDot:1
+24 KILL @RADATA
+25 QUIT
+26 ;
GETDEFG(Y) ; -- get default context settings for GUI imaging reports
+1 NEW BEG,END,MAX
+2 ;if called from CAPRI, show all reports
+3 DO OP^XQCHK
+4 IF $PIECE($GET(XQOPT),"^",1)="DVBA CAPRI GUI"
Begin DoDot:1
+5 SET BEG=$$DT^ORCHTAB1("T-36500")
+6 SET END=$$DT^ORCHTAB1("T")
+7 SET MAX="9999"
+8 SET Y=BEG_"^"_END_"^"_MAX
End DoDot:1
+9 ; if not CAPRI, use CPRS defaults
+10 IF '$TEST
DO GETIMG^ORWTPD(.Y,"")
+11 QUIT
GETDEF(Y) ; -- get default context settings for LM imaging reports
+1 NEW BEG,CONTEXT,END,MAX
+2 SET CONTEXT=$$GET^XPAR("ALL","ORCH CONTEXT REPORTS")
+3 SET BEG=$$DT^ORCHTAB1($PIECE(CONTEXT,";"))
+4 SET END=$$DT^ORCHTAB1($PIECE(CONTEXT,";",2))
+5 SET MAX=$PIECE(CONTEXT,";",5)
+6 DO OP^XQCHK
+7 IF $PIECE($GET(XQOPT),"^",1)="DVBA CAPRI GUI"
Begin DoDot:1
+8 SET BEG=$$DT^ORCHTAB1("T-36500")
+9 SET END=$$DT^ORCHTAB1("T")
+10 SET MAX="9999"
End DoDot:1
+11 SET Y=BEG_"^"_END_"^"_MAX
+12 QUIT
+13 ;
RPT1(ROOT,DFN,ORID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ; -- return imaging report
+1 DO RPT(.ROOT,.DFN,.ORID,.ALPHA,.OMEGA,.DTRANGE,.REMOTE,.ORMAX,.ORFHIE)
+2 QUIT
RPT(ROOT,DFN,ORID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ; -- return imaging report
+1 ; RPC: ORWRA REPORT TEXT
+2 ; See RPC definition for details on input and output parameters
+3 ; -- init locals and globals
+4 NEW ID,LCNT,ORVP,EXAMDATE,CASENMBR
+5 SET RADATA=$NAME(^TMP($JOB,"RAE3"))
+6 SET ROOT=$NAME(^TMP("ORXPND",$JOB))
+7 KILL @RADATA,@ROOT
+8 ;
+9 ; -- set up exam id and call to get report text
+10 SET ID=$TRANSLATE(ORID,"-",U)
+11 ;
+12 ; -- set up counter and vp local for dfn for formating call
+13 SET LCNT=0
SET ORVP=DFN_";DPT("
+14 DO XRAYS^ORCXPND1
+15 KILL @RADATA
+16 QUIT
+17 ;
TEST ; -- test to get exam list
+1 NEW I,ROOT,DFN
+2 SET DFN=16
+3 DO EXAMS1(.ROOT,DFN)
+4 WRITE !,"Root: ",ROOT
+5 SET I=0
FOR
SET I=$ORDER(@ROOT@(I))
if 'I
QUIT
WRITE !,@ROOT@(I)
+6 QUIT
+7 ;
TEST1 ; -- test to print reprt for first 3 exams
+1 NEW ORI,ROOT,ROOT1,L,X,DFN
+2 SET DFN=16
+3 DO EXAMS1(.ROOT,DFN)
+4 SET ORI=0
FOR
SET ORI=$ORDER(@ROOT@(ORI))
if 'ORI
QUIT
Begin DoDot:1
+5 SET X=@ROOT@(ORI)
+6 DO RPT1(.ROOT1,DFN,$PIECE(X,U))
+7 SET L=0
FOR
SET L=$ORDER(@ROOT1@(L))
if 'L
QUIT
WRITE !,@ROOT1@(L,0)
End DoDot:1
if ORI=3
QUIT
+8 QUIT
