- 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
- 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
