ORWMC.m

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