| 1 | ORWRA ; ALB/MJK/REV/JDL -Imaging Calls ;8/6/02  1:30 [2/12/04 9:25am]
 | 
|---|
| 2 |  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,109,135,132,148,154,141,160,149,190**;Dec 17, 1997
 | 
|---|
| 3 | EXAMS(ROOT,DFN) ; Return imaging exams
 | 
|---|
| 4 |  ; RPC: ORWRA IMAGING EXAMS
 | 
|---|
| 5 |  ;  See RPC definition for details on input and output parameters
 | 
|---|
| 6 |  D GET(0)
 | 
|---|
| 7 |  Q
 | 
|---|
| 8 | EXAMS1(ROOT,DFN) ; Return imaging exams
 | 
|---|
| 9 |  ; RPC: ORWRA IMAGING EXAMS1
 | 
|---|
| 10 |  ;  See RPC definition for details on input and output parameters
 | 
|---|
| 11 |  D GET(1)
 | 
|---|
| 12 |  Q
 | 
|---|
| 13 | GET(GSITE) ;Get the data
 | 
|---|
| 14 |  N I,ID,RADATA,STRING,SITE,ORCX
 | 
|---|
| 15 |  N BEG,END,MAX,P1,P2
 | 
|---|
| 16 |  S RADATA=$NA(^TMP($J,"RAE1",DFN))
 | 
|---|
| 17 |  S ROOT=$NA(^TMP($J,"ORAEXAMS"))
 | 
|---|
| 18 |  S ORCX=1  ;show cancelled reports
 | 
|---|
| 19 |  K @RADATA,@ROOT
 | 
|---|
| 20 |  ;
 | 
|---|
| 21 |  ; -- set date range
 | 
|---|
| 22 |  D GETDEFG(.STRING)
 | 
|---|
| 23 |  S BEG=$P(STRING,U)
 | 
|---|
| 24 |  S END=$P(STRING,"^",2)
 | 
|---|
| 25 |  S MAX=$P(STRING,"^",3)
 | 
|---|
| 26 |  I GSITE="1" S MAX=MAX_"P"
 | 
|---|
| 27 |  D EN1^RAO7PC1(DFN,BEG,END,MAX,ORCX)
 | 
|---|
| 28 |  ;
 | 
|---|
| 29 |  ; -- reformat data array for rpc
 | 
|---|
| 30 |  S I=0,ID="",SITE=""
 | 
|---|
| 31 |  I $G(GSITE) S SITE=$$SITE^VASITE,SITE=$P(SITE,"^",2)_";"_$P(SITE,"^",3)_U
 | 
|---|
| 32 |  F  S ID=$O(@RADATA@(ID)) Q:ID=""  D
 | 
|---|
| 33 |  . S P1=$P($G(^TMP($J,"RAE1",DFN,ID,"CPRS")),U) ;The member of set indicator from Radiology 
 | 
|---|
| 34 |  . S P2=$P($G(^TMP($J,"RAE1",DFN,ID,"CPRS")),U,2) ;The parent procedure name from Radiology  
 | 
|---|
| 35 |  . S I=I+1
 | 
|---|
| 36 |  . S @ROOT@(I)=SITE_ID_U_(9999999.9999-ID)_U_@RADATA@(ID)_U_P1_U_P2
 | 
|---|
| 37 |  K @RADATA
 | 
|---|
| 38 |  Q
 | 
|---|
| 39 |  ;
 | 
|---|
| 40 | GETDEFG(Y) ; -- get default context settings for GUI imaging reports
 | 
|---|
| 41 |  N BEG,END,MAX
 | 
|---|
| 42 |  ;if called from CAPRI, show all reports
 | 
|---|
| 43 |  D OP^XQCHK
 | 
|---|
| 44 |  I $P($G(XQOPT),"^",1)="DVBA CAPRI GUI" D
 | 
|---|
| 45 |  . S BEG=$$DT^ORCHTAB1("T-36500")
 | 
|---|
| 46 |  . S END=$$DT^ORCHTAB1("T")
 | 
|---|
| 47 |  . S MAX="9999"
 | 
|---|
| 48 |  . S Y=BEG_"^"_END_"^"_MAX
 | 
|---|
| 49 |  ; if not CAPRI, use CPRS defaults
 | 
|---|
| 50 |  E  D GETIMG^ORWTPD(.Y,"")
 | 
|---|
| 51 |  Q
 | 
|---|
| 52 | GETDEF(Y) ; -- get default context settings for LM imaging reports
 | 
|---|
| 53 |  N BEG,CONTEXT,END,MAX
 | 
|---|
| 54 |  S CONTEXT=$$GET^XPAR("ALL","ORCH CONTEXT REPORTS")
 | 
|---|
| 55 |  S BEG=$$DT^ORCHTAB1($P(CONTEXT,";"))
 | 
|---|
| 56 |  S END=$$DT^ORCHTAB1($P(CONTEXT,";",2))
 | 
|---|
| 57 |  S MAX=$P(CONTEXT,";",5)
 | 
|---|
| 58 |  D OP^XQCHK
 | 
|---|
| 59 |  I $P($G(XQOPT),"^",1)="DVBA CAPRI GUI" D
 | 
|---|
| 60 |  .S BEG=$$DT^ORCHTAB1("T-36500")
 | 
|---|
| 61 |  .S END=$$DT^ORCHTAB1("T")
 | 
|---|
| 62 |  .S MAX="9999"
 | 
|---|
| 63 |  S Y=BEG_"^"_END_"^"_MAX
 | 
|---|
| 64 |  Q
 | 
|---|
| 65 |  ;
 | 
|---|
| 66 | RPT1(ROOT,DFN,ORID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ; -- return imaging report
 | 
|---|
| 67 |  D RPT(.ROOT,.DFN,.ORID,.ALPHA,.OMEGA,.DTRANGE,.REMOTE,.ORMAX,.ORFHIE)
 | 
|---|
| 68 |  Q
 | 
|---|
| 69 | RPT(ROOT,DFN,ORID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ; -- return imaging report
 | 
|---|
| 70 |  ;  RPC: ORWRA REPORT TEXT
 | 
|---|
| 71 |  ;  See RPC definition for details on input and output parameters
 | 
|---|
| 72 |  ; -- init locals and globals
 | 
|---|
| 73 |  N ID,LCNT,ORVP,EXAMDATE,CASENMBR
 | 
|---|
| 74 |  S RADATA=$NA(^TMP($J,"RAE3"))
 | 
|---|
| 75 |  S ROOT=$NA(^TMP("ORXPND",$J))
 | 
|---|
| 76 |  K @RADATA,@ROOT
 | 
|---|
| 77 |  ; 
 | 
|---|
| 78 |  ; -- set up exam id and call to get report text
 | 
|---|
| 79 |  S ID=$TR(ORID,"-",U)
 | 
|---|
| 80 |  ;
 | 
|---|
| 81 |  ; -- set up counter and vp local for dfn for formating call
 | 
|---|
| 82 |  S LCNT=0,ORVP=DFN_";DPT("
 | 
|---|
| 83 |  D XRAYS^ORCXPND1
 | 
|---|
| 84 |  K @RADATA
 | 
|---|
| 85 |  Q
 | 
|---|
| 86 |  ;
 | 
|---|
| 87 | TEST ; -- test to get exam list
 | 
|---|
| 88 |  N I,ROOT,DFN
 | 
|---|
| 89 |  S DFN=16
 | 
|---|
| 90 |  D EXAMS1(.ROOT,DFN)
 | 
|---|
| 91 |  W !,"Root: ",ROOT
 | 
|---|
| 92 |  S I=0 F  S I=$O(@ROOT@(I)) Q:'I  W !,@ROOT@(I)
 | 
|---|
| 93 |  Q
 | 
|---|
| 94 |  ;
 | 
|---|
| 95 | TEST1 ; -- test to print reprt for first 3 exams
 | 
|---|
| 96 |  N ORI,ROOT,ROOT1,L,X,DFN
 | 
|---|
| 97 |  S DFN=16
 | 
|---|
| 98 |  D EXAMS1(.ROOT,DFN)
 | 
|---|
| 99 |  S ORI=0 F  S ORI=$O(@ROOT@(ORI)) Q:'ORI  D  Q:ORI=3
 | 
|---|
| 100 |  . S X=@ROOT@(ORI)
 | 
|---|
| 101 |  . D RPT1(.ROOT1,DFN,$P(X,U))
 | 
|---|
| 102 |  . S L=0 F  S L=$O(@ROOT1@(L)) Q:'L  W !,@ROOT1@(L,0)
 | 
|---|
| 103 |  Q
 | 
|---|