| 1 | ORWMC ; slc/dcm -Medicine Calls ;4/2/98 15:02
|
|---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,109**;Dec 17, 1997
|
|---|
| 3 | PROD(ROOT,DFN) ; Return procedures
|
|---|
| 4 | ; RPC: ORWMC PROCEDURES
|
|---|
| 5 | ; See RPC definition for details on input and output parameters
|
|---|
| 6 | D GET(0)
|
|---|
| 7 | Q
|
|---|
| 8 | PROD1(ROOT,DFN) ; Return procedures
|
|---|
| 9 | ; RPC: ORWMC PROCEDURES
|
|---|
| 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 MCDATA,I,X,X1,X2,ID,SITE
|
|---|
| 15 | S MCDATA=$NA(^TMP("OR",$J,"MCAR","OT"))
|
|---|
| 16 | S ROOT=$NA(^TMP("OR",$J,"MCAR","GUI"))
|
|---|
| 17 | K @MCDATA,@ROOT
|
|---|
| 18 | D EN^MCARPS2(DFN)
|
|---|
| 19 | ; -- reformat data array for rpc
|
|---|
| 20 | S ID="",SITE=""
|
|---|
| 21 | I $G(GSITE) S SITE=$$SITE^VASITE,SITE=$P(SITE,"^",2)_";"_$P(SITE,"^",3)_U
|
|---|
| 22 | F S ID=$O(@MCDATA@(ID)) Q:ID="" D
|
|---|
| 23 | . S @ROOT@(ID)=SITE_ID_U_@MCDATA@(ID)
|
|---|
| 24 | ;K @MCDATA
|
|---|
| 25 | Q
|
|---|
| 26 | ;
|
|---|
| 27 | RPT(ROOT,DFN,ORID) ; -- return medicine report
|
|---|
| 28 | ; RPC: ORWMC REPORT TEXT
|
|---|
| 29 | ; See RPC definition for details on input and output parameters
|
|---|
| 30 | ; N IORVON,IORVOFF S (IORVON,IORVOFF)=""
|
|---|
| 31 | ;
|
|---|
| 32 | ; -- init locals and globals
|
|---|
| 33 | N ID,LCNT,ORVP,DA,MCARGDA,MCARPPS,MCPRO
|
|---|
| 34 | S MCDATA=$NA(^TMP("OR",$J,"MCAR","OT"))
|
|---|
| 35 | S ROOT=$NA(^TMP("ORXPND",$J))
|
|---|
| 36 | K @ROOT ;K @MCDATA REMOVED
|
|---|
| 37 | ; -- set up procedure id and call to get report text
|
|---|
| 38 | 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)
|
|---|
| 39 | D MCPPROC^MCARP
|
|---|
| 40 | S MCARGRTN=$P(ID,U,6)
|
|---|
| 41 | D @MCARPPS
|
|---|
| 42 | ; -- set up counter and vp local for dfn for formating call
|
|---|
| 43 | K @MCDATA
|
|---|
| 44 | Q
|
|---|
| 45 | ;
|
|---|
| 46 | TEST ; -- test to get exam list
|
|---|
| 47 | N I,ROOT,DFN
|
|---|
| 48 | S DFN=17
|
|---|
| 49 | D PROD1(.ROOT,DFN)
|
|---|
| 50 | W !,"Root: ",ROOT
|
|---|
| 51 | S I=0 F S I=$O(@ROOT@(I)) Q:'I W !,@ROOT@(I)
|
|---|
| 52 | Q
|
|---|
| 53 | ;
|
|---|
| 54 | TEST1 ; -- test to print reprt for first 3 exams
|
|---|
| 55 | N I,ROOT,ROOT1,L,X,DFN,XQY0,ORHFS
|
|---|
| 56 | S DFN=17,XQY0="ORTEST",ORHFS=1
|
|---|
| 57 | D PROD1(.ROOT,DFN)
|
|---|
| 58 | W !,"Root: "_ROOT
|
|---|
| 59 | S I=0 F S I=$O(@ROOT@(I)) Q:'I D Q
|
|---|
| 60 | . S X=@ROOT@(I)
|
|---|
| 61 | . D RPT(.ROOT,DFN,I)
|
|---|
| 62 | . ;S L=0 F S L=$O(@ROOT@(L)) Q:'L W !,@ROOT@(L)
|
|---|
| 63 | Q
|
|---|
