- 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 Feb 18, 2025@23:13:34 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
