ORWMC ; slc/dcm -Medicine Calls ;4/2/98 15:02
;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,109**;Dec 17, 1997
PROD(ROOT,DFN) ; Return procedures
; RPC: ORWMC PROCEDURES
; See RPC definition for details on input and output parameters
D GET(0)
Q
PROD1(ROOT,DFN) ; Return procedures
; RPC: ORWMC PROCEDURES
; See RPC definition for details on input and output parameters
D GET(1)
Q
GET(GSITE) ;Get the data
N MCDATA,I,X,X1,X2,ID,SITE
S MCDATA=$NA(^TMP("OR",$J,"MCAR","OT"))
S ROOT=$NA(^TMP("OR",$J,"MCAR","GUI"))
K @MCDATA,@ROOT
D EN^MCARPS2(DFN)
; -- reformat data array for rpc
S ID="",SITE=""
I $G(GSITE) S SITE=$$SITE^VASITE,SITE=$P(SITE,"^",2)_";"_$P(SITE,"^",3)_U
F S ID=$O(@MCDATA@(ID)) Q:ID="" D
. S @ROOT@(ID)=SITE_ID_U_@MCDATA@(ID)
;K @MCDATA
Q
;
RPT(ROOT,DFN,ORID) ; -- return medicine report
; RPC: ORWMC REPORT TEXT
; See RPC definition for details on input and output parameters
; N IORVON,IORVOFF S (IORVON,IORVOFF)=""
;
; -- init locals and globals
N ID,LCNT,ORVP,DA,MCARGDA,MCARPPS,MCPRO
S MCDATA=$NA(^TMP("OR",$J,"MCAR","OT"))
S ROOT=$NA(^TMP("ORXPND",$J))
K @ROOT ;K @MCDATA REMOVED
; -- set up procedure id and call to get report text
S ID=^TMP("OR",$J,"MCAR","OT",ORID),(DA,MCARGDA)=$P(ID,U,3),MCARPPS=$P(ID,U,4,5),MCPRO=$P(ID,U,12)
D MCPPROC^MCARP
S MCARGRTN=$P(ID,U,6)
D @MCARPPS
; -- set up counter and vp local for dfn for formating call
K @MCDATA
Q
;
TEST ; -- test to get exam list
N I,ROOT,DFN
S DFN=17
D PROD1(.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 I,ROOT,ROOT1,L,X,DFN,XQY0,ORHFS
S DFN=17,XQY0="ORTEST",ORHFS=1
D PROD1(.ROOT,DFN)
W !,"Root: "_ROOT
S I=0 F S I=$O(@ROOT@(I)) Q:'I D Q
. S X=@ROOT@(I)
. D RPT(.ROOT,DFN,I)
. ;S L=0 F S L=$O(@ROOT@(L)) Q:'L W !,@ROOT@(L)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWMC 1921 printed Dec 13, 2024@02:36:44 Page 2
ORWMC ; slc/dcm -Medicine Calls ;4/2/98 15:02
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,109**;Dec 17, 1997
PROD(ROOT,DFN) ; Return procedures
+1 ; RPC: ORWMC PROCEDURES
+2 ; See RPC definition for details on input and output parameters
+3 DO GET(0)
+4 QUIT
PROD1(ROOT,DFN) ; Return procedures
+1 ; RPC: ORWMC PROCEDURES
+2 ; See RPC definition for details on input and output parameters
+3 DO GET(1)
+4 QUIT
GET(GSITE) ;Get the data
+1 NEW MCDATA,I,X,X1,X2,ID,SITE
+2 SET MCDATA=$NAME(^TMP("OR",$JOB,"MCAR","OT"))
+3 SET ROOT=$NAME(^TMP("OR",$JOB,"MCAR","GUI"))
+4 KILL @MCDATA,@ROOT
+5 DO EN^MCARPS2(DFN)
+6 ; -- reformat data array for rpc
+7 SET ID=""
SET SITE=""
+8 IF $GET(GSITE)
SET SITE=$$SITE^VASITE
SET SITE=$PIECE(SITE,"^",2)_";"_$PIECE(SITE,"^",3)_U
+9 FOR
SET ID=$ORDER(@MCDATA@(ID))
if ID=""
QUIT
Begin DoDot:1
+10 SET @ROOT@(ID)=SITE_ID_U_@MCDATA@(ID)
End DoDot:1
+11 ;K @MCDATA
+12 QUIT
+13 ;
RPT(ROOT,DFN,ORID) ; -- return medicine report
+1 ; RPC: ORWMC REPORT TEXT
+2 ; See RPC definition for details on input and output parameters
+3 ; N IORVON,IORVOFF S (IORVON,IORVOFF)=""
+4 ;
+5 ; -- init locals and globals
+6 NEW ID,LCNT,ORVP,DA,MCARGDA,MCARPPS,MCPRO
+7 SET MCDATA=$NAME(^TMP("OR",$JOB,"MCAR","OT"))
+8 SET ROOT=$NAME(^TMP("ORXPND",$JOB))
+9 ;K @MCDATA REMOVED
KILL @ROOT
+10 ; -- set up procedure id and call to get report text
+11 SET ID=^TMP("OR",$JOB,"MCAR","OT",ORID)
SET (DA,MCARGDA)=$PIECE(ID,U,3)
SET MCARPPS=$PIECE(ID,U,4,5)
SET MCPRO=$PIECE(ID,U,12)
+12 DO MCPPROC^MCARP
+13 SET MCARGRTN=$PIECE(ID,U,6)
+14 DO @MCARPPS
+15 ; -- set up counter and vp local for dfn for formating call
+16 KILL @MCDATA
+17 QUIT
+18 ;
TEST ; -- test to get exam list
+1 NEW I,ROOT,DFN
+2 SET DFN=17
+3 DO PROD1(.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 I,ROOT,ROOT1,L,X,DFN,XQY0,ORHFS
+2 SET DFN=17
SET XQY0="ORTEST"
SET ORHFS=1
+3 DO PROD1(.ROOT,DFN)
+4 WRITE !,"Root: "_ROOT
+5 SET I=0
FOR
SET I=$ORDER(@ROOT@(I))
if 'I
QUIT
Begin DoDot:1
+6 SET X=@ROOT@(I)
+7 DO RPT(.ROOT,DFN,I)
+8 ;S L=0 F S L=$O(@ROOT@(L)) Q:'L W !,@ROOT@(L)
End DoDot:1
QUIT
+9 QUIT
