GMRCSLM3 ;SLC/DCM - Extract medicine results for consult tracking ;7/16/98 02:01
;;3.0;CONSULT/REQUEST TRACKING;**1,4,15**;DEC 27, 1997
;
; This routine invokes IA #615,#3042
;
EN(GMRCSEL,GMRCSR,COUNT) ;;This entry point is used to collect consult data from the Medicine Package.
;GMRCSR="^MCAR(x," file IEN where result to associate is stored
;in $P(^GMR(123,IEN,0),"^",15)
; 1=Called from RT^GMRCA1 or DT^GMRCSLM2 routine
;Consult/Request Tracking
;GMRCSEL: The IEN of the consult from file 123.
;COUNT: The current position in ^TMP where data is to be placed.
D ENDT,EXIT Q
;
ENDT Q:'$D(GMRCSEL) Q:'$D(GMRCSEL)
S ORIFN=$P(^GMR(123,GMRCSEL,0),"^",3),ORACTION=8
S ^TMP("GMRCR",$J,"DT",COUNT,0)="",COUNT=COUNT+1
S X="MCOR" X ^%ZOSF("TEST") I '$T S ^TMP("GMRCR",$J,"DT",COUNT,0)="Medicine package not installed. Online results are not available.",COUNT=COUNT+1
I 'GMRCSR S ^TMP("GMRCR",$J,"DT",COUNT,0)="No Medicine results are available for review",COUNT=COUNT+1 Q
N SINGLE
S SINGLE=$$SINGLE^MCAPI(GMRCSR)
S GMRCRTIT=$P(SINGLE,U)_" SUMMARY REPORT "_$P(SINGLE,U,6)
S GMRCH="",$P(GMRCH,"-",(77-$L(GMRCRTIT))\2)=""
S ^TMP("GMRCR",$J,"DT",COUNT,0)=GMRCH_" "_GMRCRTIT_" "_GMRCH
S COUNT=COUNT+1,^TMP("GMRCR",$J,"DT",COUNT,0)="",COUNT=COUNT+1
D PRINT^MCOR I '$D(^TMP("MC",$J)) D
. S ^TMP("GMRCR",$J,"DT",COUNT,0)="No results are available for review."
. S COUNT=COUNT+1
;GMRCFT=Field Type of D (Diagnosis, I (Indications), S (Summary)
SET S GMRCFT="D" I $D(^TMP("MC",$J,"D")) D
. S ^TMP("GMRCR",$J,"DT",COUNT,0)=$E(TAB,1,34)_"DIAGNOSIS"
. S COUNT=COUNT+1
. D SETFLD
S GMRCFT="I" I $D(^TMP("MC",$J,"I")) D
. S ^TMP("GMRCR",$J,"DT",COUNT,0)="",COUNT=COUNT+1
. S ^TMP("GMRCR",$J,"DT",COUNT,0)="INDICATIONS:",COUNT=COUNT+1
. D SETFLD
I $D(^TMP("MC",$J,"S")) D SUM
Q
EXIT K GMRCH,GMRCX,GMRCFT,GMRCFLD,GMRCSUM,GMRCFLDN,GMRCSUMP,GMRCRTIT
K GMRCPRNM,GMRCFLDP,MCC,MCK,MCMFLD,MCMUP
K ^TMP("MC",$J)
Q
SETFLD S GMRCFLD=0,GMRCFLDP=""
F S GMRCFLD=$O(^TMP("MC",$J,GMRCFT,GMRCFLD)) Q:GMRCFLD="" D
. S GMRCFLD(0)=^TMP("MC",$J,GMRCFT,GMRCFLD) D
.. S GMRCFLDN=$P(GMRCFLD(0),"^",2) Q:GMRCFLDN[";W"
.. I GMRCFLDP=GMRCFLDN S COUNT=COUNT-1,^TMP("GMRCR",$J,"DT",COUNT,0)=^TMP("GMRCR",$J,"DT",COUNT,0)_", "
.. E S GMRCFLDP=GMRCFLDN,^TMP("GMRCR",$J,"DT",COUNT,0)=GMRCFLDP_":"_$E(TAB,1,18-$L(GMRCFLDP))
.. I $L($P(GMRCFLD(0),"^",1))>45 D Q
... S ^TMP("GMRCR",$J,"DT",COUNT,0)=^TMP("GMRCR",$J,"DT",COUNT,0)_$P(GMRCFLD(0),U)
... S COUNT=COUNT+1
.. I $L($P(GMRCFLD(0),"^",1))'>77 S ^TMP("GMRCR",$J,"DT",COUNT,0)=^TMP("GMRCR",$J,"DT",COUNT,0)_$P(GMRCFLD(0),"^",1)
.. S COUNT=COUNT+1 Q
Q
SUM ;
S GMRCSUM=$P(^TMP("MC",$J,"S"),"^",1)
S GMRCSUMP=$P(^TMP("MC",$J,"S"),"^",2)
I $L(GMRCSUM)!($L(GMRCSUMP)) S ^TMP("GMRCR",$J,"DT",COUNT,0)="SUMMARY:"
I $L(GMRCSUM) S ^TMP("GMRCR",$J,"DT",COUNT,0)=^TMP("GMRCR",$J,"DT",COUNT,0)_$E(TAB,1,11)_GMRCSUM,COUNT=COUNT+1
I $L(GMRCSUMP) S ^TMP("GMRCR",$J,"DT",COUNT,0)="SUMMARY PROCEDURE: "_GMRCSUMP,COUNT=COUNT+1
Q
AREN(GMRCSEL,GMRCSR,GMRCPROC) ;Entry point for display of Medicine Results when associating a result with a consult - List Manager display set-up.
;GMRCSR=^MCAR(191, file IEN where result to associate is stored
;GMRCSEL=File ^GMR(123, IEN of consult to associate with medicine result
;GMRCPROC=pointer to GMRC PROCEDURE (#123.3) file
S COUNT=1,TAB="",TAB=$P(TAB," ",30)
S X="MCOR" X ^%ZOSF("TEST") I '$T S ^TMP("GMRCR",$J,"DT",COUNT,0)="Medicine Package is not installed. Online results are not available.",COUNT=COUNT+1 G END
I 'GMRCSR S ^TMP("GMRCR",$J,"DT",COUNT,0)="No Medicine results are available for review.",COUNT=COUNT+1
S ORIFN=$S($G(GMRCSEL):$P(^GMR(123,+GMRCSEL,0),"^",3),1:0),ORACTION=8
S:+GMRCPROC GMRCPRNM=$$GET1^DIQ(697.2,$P(^GMR(123.3,+GMRCPROC,0),U,5),7)
S GMRCPRNM=$S($L($G(GMRCPRNM)):GMRCPRNM,1:"ELECTROCARDIOGRAM")
I +GMRCSR D PRINT^MCOR I $D(^TMP("MC",$J)) S ^TMP("GMRCR",$J,"DT",COUNT,0)=TAB_"MEDICINE RESULTS",COUNT=COUNT+1,^TMP("GMRCR",$J,"DT",COUNT,0)="",COUNT=COUNT+1 D SET
S ^TMP("GMRCR",$J,"DT",COUNT,0)="",COUNT=COUNT+1
END S GMRCCT=COUNT-1
K COUNT,GMRCH,GMRCFT,GMRCFLD,GMRCSUM,GMRCFLDN,GMRCSUMP,GMRCRTIT,GMRCPRNM,GMRCFLDP,MCC,MCK,MCMFLD,MCMUP
K ^TMP("MC",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCSLM3 4274 printed Dec 13, 2024@01:47:11 Page 2
GMRCSLM3 ;SLC/DCM - Extract medicine results for consult tracking ;7/16/98 02:01
+1 ;;3.0;CONSULT/REQUEST TRACKING;**1,4,15**;DEC 27, 1997
+2 ;
+3 ; This routine invokes IA #615,#3042
+4 ;
EN(GMRCSEL,GMRCSR,COUNT) ;;This entry point is used to collect consult data from the Medicine Package.
+1 ;GMRCSR="^MCAR(x," file IEN where result to associate is stored
+2 ;in $P(^GMR(123,IEN,0),"^",15)
+3 ; 1=Called from RT^GMRCA1 or DT^GMRCSLM2 routine
+4 ;Consult/Request Tracking
+5 ;GMRCSEL: The IEN of the consult from file 123.
+6 ;COUNT: The current position in ^TMP where data is to be placed.
+7 DO ENDT
DO EXIT
QUIT
+8 ;
ENDT if '$DATA(GMRCSEL)
QUIT
if '$DATA(GMRCSEL)
QUIT
+1 SET ORIFN=$PIECE(^GMR(123,GMRCSEL,0),"^",3)
SET ORACTION=8
+2 SET ^TMP("GMRCR",$JOB,"DT",COUNT,0)=""
SET COUNT=COUNT+1
+3 SET X="MCOR"
XECUTE ^%ZOSF("TEST")
IF '$TEST
SET ^TMP("GMRCR",$JOB,"DT",COUNT,0)="Medicine package not installed. Online results are not available."
SET COUNT=COUNT+1
+4 IF 'GMRCSR
SET ^TMP("GMRCR",$JOB,"DT",COUNT,0)="No Medicine results are available for review"
SET COUNT=COUNT+1
QUIT
+5 NEW SINGLE
+6 SET SINGLE=$$SINGLE^MCAPI(GMRCSR)
+7 SET GMRCRTIT=$PIECE(SINGLE,U)_" SUMMARY REPORT "_$PIECE(SINGLE,U,6)
+8 SET GMRCH=""
SET $PIECE(GMRCH,"-",(77-$LENGTH(GMRCRTIT))\2)=""
+9 SET ^TMP("GMRCR",$JOB,"DT",COUNT,0)=GMRCH_" "_GMRCRTIT_" "_GMRCH
+10 SET COUNT=COUNT+1
SET ^TMP("GMRCR",$JOB,"DT",COUNT,0)=""
SET COUNT=COUNT+1
+11 DO PRINT^MCOR
IF '$DATA(^TMP("MC",$JOB))
Begin DoDot:1
+12 SET ^TMP("GMRCR",$JOB,"DT",COUNT,0)="No results are available for review."
+13 SET COUNT=COUNT+1
End DoDot:1
+14 ;GMRCFT=Field Type of D (Diagnosis, I (Indications), S (Summary)
SET SET GMRCFT="D"
IF $DATA(^TMP("MC",$JOB,"D"))
Begin DoDot:1
+1 SET ^TMP("GMRCR",$JOB,"DT",COUNT,0)=$EXTRACT(TAB,1,34)_"DIAGNOSIS"
+2 SET COUNT=COUNT+1
+3 DO SETFLD
End DoDot:1
+4 SET GMRCFT="I"
IF $DATA(^TMP("MC",$JOB,"I"))
Begin DoDot:1
+5 SET ^TMP("GMRCR",$JOB,"DT",COUNT,0)=""
SET COUNT=COUNT+1
+6 SET ^TMP("GMRCR",$JOB,"DT",COUNT,0)="INDICATIONS:"
SET COUNT=COUNT+1
+7 DO SETFLD
End DoDot:1
+8 IF $DATA(^TMP("MC",$JOB,"S"))
DO SUM
+9 QUIT
EXIT KILL GMRCH,GMRCX,GMRCFT,GMRCFLD,GMRCSUM,GMRCFLDN,GMRCSUMP,GMRCRTIT
+1 KILL GMRCPRNM,GMRCFLDP,MCC,MCK,MCMFLD,MCMUP
+2 KILL ^TMP("MC",$JOB)
+3 QUIT
SETFLD SET GMRCFLD=0
SET GMRCFLDP=""
+1 FOR
SET GMRCFLD=$ORDER(^TMP("MC",$JOB,GMRCFT,GMRCFLD))
if GMRCFLD=""
QUIT
Begin DoDot:1
+2 SET GMRCFLD(0)=^TMP("MC",$JOB,GMRCFT,GMRCFLD)
Begin DoDot:2
+3 SET GMRCFLDN=$PIECE(GMRCFLD(0),"^",2)
if GMRCFLDN[";W"
QUIT
+4 IF GMRCFLDP=GMRCFLDN
SET COUNT=COUNT-1
SET ^TMP("GMRCR",$JOB,"DT",COUNT,0)=^TMP("GMRCR",$JOB,"DT",COUNT,0)_", "
+5 IF '$TEST
SET GMRCFLDP=GMRCFLDN
SET ^TMP("GMRCR",$JOB,"DT",COUNT,0)=GMRCFLDP_":"_$EXTRACT(TAB,1,18-$LENGTH(GMRCFLDP))
+6 IF $LENGTH($PIECE(GMRCFLD(0),"^",1))>45
Begin DoDot:3
+7 SET ^TMP("GMRCR",$JOB,"DT",COUNT,0)=^TMP("GMRCR",$JOB,"DT",COUNT,0)_$PIECE(GMRCFLD(0),U)
+8 SET COUNT=COUNT+1
End DoDot:3
QUIT
+9 IF $LENGTH($PIECE(GMRCFLD(0),"^",1))'>77
SET ^TMP("GMRCR",$JOB,"DT",COUNT,0)=^TMP("GMRCR",$JOB,"DT",COUNT,0)_$PIECE(GMRCFLD(0),"^",1)
+10 SET COUNT=COUNT+1
QUIT
End DoDot:2
End DoDot:1
+11 QUIT
SUM ;
+1 SET GMRCSUM=$PIECE(^TMP("MC",$JOB,"S"),"^",1)
+2 SET GMRCSUMP=$PIECE(^TMP("MC",$JOB,"S"),"^",2)
+3 IF $LENGTH(GMRCSUM)!($LENGTH(GMRCSUMP))
SET ^TMP("GMRCR",$JOB,"DT",COUNT,0)="SUMMARY:"
+4 IF $LENGTH(GMRCSUM)
SET ^TMP("GMRCR",$JOB,"DT",COUNT,0)=^TMP("GMRCR",$JOB,"DT",COUNT,0)_$EXTRACT(TAB,1,11)_GMRCSUM
SET COUNT=COUNT+1
+5 IF $LENGTH(GMRCSUMP)
SET ^TMP("GMRCR",$JOB,"DT",COUNT,0)="SUMMARY PROCEDURE: "_GMRCSUMP
SET COUNT=COUNT+1
+6 QUIT
AREN(GMRCSEL,GMRCSR,GMRCPROC) ;Entry point for display of Medicine Results when associating a result with a consult - List Manager display set-up.
+1 ;GMRCSR=^MCAR(191, file IEN where result to associate is stored
+2 ;GMRCSEL=File ^GMR(123, IEN of consult to associate with medicine result
+3 ;GMRCPROC=pointer to GMRC PROCEDURE (#123.3) file
+4 SET COUNT=1
SET TAB=""
SET TAB=$PIECE(TAB," ",30)
+5 SET X="MCOR"
XECUTE ^%ZOSF("TEST")
IF '$TEST
SET ^TMP("GMRCR",$JOB,"DT",COUNT,0)="Medicine Package is not installed. Online results are not available."
SET COUNT=COUNT+1
GOTO END
+6 IF 'GMRCSR
SET ^TMP("GMRCR",$JOB,"DT",COUNT,0)="No Medicine results are available for review."
SET COUNT=COUNT+1
+7 SET ORIFN=$SELECT($GET(GMRCSEL):$PIECE(^GMR(123,+GMRCSEL,0),"^",3),1:0)
SET ORACTION=8
+8 if +GMRCPROC
SET GMRCPRNM=$$GET1^DIQ(697.2,$PIECE(^GMR(123.3,+GMRCPROC,0),U,5),7)
+9 SET GMRCPRNM=$SELECT($LENGTH($GET(GMRCPRNM)):GMRCPRNM,1:"ELECTROCARDIOGRAM")
+10 IF +GMRCSR
DO PRINT^MCOR
IF $DATA(^TMP("MC",$JOB))
SET ^TMP("GMRCR",$JOB,"DT",COUNT,0)=TAB_"MEDICINE RESULTS"
SET COUNT=COUNT+1
SET ^TMP("GMRCR",$JOB,"DT",COUNT,0)=""
SET COUNT=COUNT+1
DO SET
+11 SET ^TMP("GMRCR",$JOB,"DT",COUNT,0)=""
SET COUNT=COUNT+1
END SET GMRCCT=COUNT-1
+1 KILL COUNT,GMRCH,GMRCFT,GMRCFLD,GMRCSUM,GMRCFLDN,GMRCSUMP,GMRCRTIT,GMRCPRNM,GMRCFLDP,MCC,MCK,MCMFLD,MCMUP
+2 KILL ^TMP("MC",$JOB)
+3 QUIT
