source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWMC.m@ 813

Last change on this file since 813 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.8 KB
Line 
1ORWMC ; slc/dcm -Medicine Calls ;4/2/98 15:02
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,109**;Dec 17, 1997
3PROD(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
8PROD1(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
13GET(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 ;
27RPT(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 ;
46TEST ; -- 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 ;
54TEST1 ; -- 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
Note: See TracBrowser for help on using the repository browser.