Routine: ORWRA

ORWRA ; ALB/MJK/REV/JDL -Imaging Calls ;17-Jun-2009 16:29;PLS

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,109,135,132,148,154,141,160,149,190,1002,1005**;Dec 17, 1997

 ; IHS/MSC/DKM - 05/02/2007 - Added BEG, END, MAX parameters

EXAMS(ROOT,DFN,BEG,END,MAX) ; Return imaging exams

 ; RPC: ORWRA IMAGING EXAMS

 ;  See RPC definition for details on input and output parameters

 D GET(0,.BEG,.END,.MAX)

 ; IHS/MSC/DKM - 05/02/2007 - Added BEG, END, MAX parameters

EXAMS1(ROOT,DFN,BEG,END,MAX) ; Return imaging exams

 ; RPC: ORWRA IMAGING EXAMS1

 ;  See RPC definition for details on input and output parameters

 D GET(1,.BEG,.END,.MAX)

 ; IHS/MSC/DKM - 05/02/2007 - Modified to support new parameters

GET(GSITE,BEG,END,MAX) ;Get the data

 N I,ID,RADATA,STRING,SITE,ORCX

 N 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:'$L($G(BEG)) BEG=$P(STRING,U)

 S:'$L($G(END)) END=$P(STRING,"^",2)

 S:'$L($G(MAX)) MAX=$P(STRING,"^",3)

 I $L(BEG),BEG'=+BEG D DT^DILF("T",BEG,.BEG)

 I $L(END),END'=+END D DT^DILF("T",END,.END)

 S @ROOT@(-1)=BEG_U_END_U_MAX

 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

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,"")

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

RPT1(ROOT,DFN,ORID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ; -- return imaging report

 D RPT(.ROOT,.DFN,.ORID,.ALPHA,.OMEGA,.DTRANGE,.REMOTE,.ORMAX,.ORFHIE)

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

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)

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)

ORWRA     ; ALB/MJK/REV/JDL -Imaging Calls ;17-Jun-2009 16:29;PLS

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,109,135,132,148,154,141,160,149,190,1002,1005**;Dec 17, 1997

 +2       ; IHS/MSC/DKM - 05/02/2007 - Added BEG, END, MAX parameters

EXAMS(ROOT,DFN,BEG,END,MAX) ; Return imaging exams

 +1       ; RPC: ORWRA IMAGING EXAMS

 +2       ;  See RPC definition for details on input and output parameters

 +3        DO GET(0,.BEG,.END,.MAX)

 +4        QUIT

 +5       ; IHS/MSC/DKM - 05/02/2007 - Added BEG, END, MAX parameters

EXAMS1(ROOT,DFN,BEG,END,MAX) ; Return imaging exams

 +1       ; RPC: ORWRA IMAGING EXAMS1

 +2       ;  See RPC definition for details on input and output parameters

 +3        DO GET(1,.BEG,.END,.MAX)

 +4        QUIT

 +5       ; IHS/MSC/DKM - 05/02/2007 - Modified to support new parameters

GET(GSITE,BEG,END,MAX) ;Get the data

 +1        NEW I,ID,RADATA,STRING,SITE,ORCX

 +2        NEW 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       IF '$LENGTH($GET(BEG))

               SET BEG=$PIECE(STRING,U)

 +11       IF '$LENGTH($GET(END))

               SET END=$PIECE(STRING,"^",2)

 +12       IF '$LENGTH($GET(MAX))

               SET MAX=$PIECE(STRING,"^",3)

 +13       IF $LENGTH(BEG)

               IF BEG'=+BEG

                   DO DT^DILF("T",BEG,.BEG)

 +14       IF $LENGTH(END)

               IF END'=+END

                   DO DT^DILF("T",END,.END)

 +15       SET @ROOT@(-1)=BEG_U_END_U_MAX

 +16       IF GSITE="1"

               SET MAX=MAX_"P"

 +17       DO EN1^RAO7PC1(DFN,BEG,END,MAX,ORCX)

 +18      ;

 +19      ; -- reformat data array for rpc

 +20       SET I=0

           SET ID=""

           SET SITE=""

 +21       IF $GET(GSITE)

               SET SITE=$$SITE^VASITE

               SET SITE=$PIECE(SITE,"^",2)_";"_$PIECE(SITE,"^",3)_U

 +22       FOR

               SET ID=$ORDER(@RADATA@(ID))

               IF ID=""

                   QUIT

               Begin DoDot:1

 +23      ;The member of set indicator from Radiology

                   SET P1=$PIECE($GET(^TMP($JOB,"RAE1",DFN,ID,"CPRS")),U)

 +24      ;The parent procedure name from Radiology

                   SET P2=$PIECE($GET(^TMP($JOB,"RAE1",DFN,ID,"CPRS")),U,2)

 +25               SET I=I+1

 +26               SET @ROOT@(I)=SITE_ID_U_(9999999.9999-ID)_U_@RADATA@(ID)_U_P1_U_P2

               End DoDot:1

 +27       KILL @RADATA

 +28       QUIT

 +29      ;

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

ORWRA.m