- GMRCAR ;SLC/DLT,JFR - Associate Results ;7/21/00 12:20
- ;;3.0;CONSULT/REQUEST TRACKING;**1,15**;DEC 27, 1997
- AR ;Associate results with request
- I $D(IOTM),$D(IOBM),$D(IOSTBM) D FULL^VALM1
- I '$D(GMRCSEL) D SEL^GMRCA2 I $D(DTOUT)!$D(DIROUT) S GMRCQIT="" Q
- I 'GMRCSEL G END
- S GMRCO=$O(^TMP("GMRCR",$J,"CS","AD",GMRCSEL,GMRCSEL,0)),GMRC(0)=^GMR(123,GMRCO,0)
- I $P(GMRC(0),"^",12)=1 W !!,"THIS ORDER HAS BEEN DISCONTINUED, PLEASE SELECT OR ADD ANOTHER ORDER!",!! G END
- S GMRCQIT="" Q
- ARMED ;Entry to associate results with a consult/request
- N GMRCQIT,GMRCQUT,GMRCPROC,GMRCSR,MCROOT,MCFILE,Y
- I '$$VERSION^XPDUTL("MC") D Q
- . N GMRCMSG
- . S GMRCMSG="Medicine Package Not Installed. Can't Associate Results."
- . D EXAC^GMRCADC(GMRCMSG)
- I $$VERSION^XPDUTL("MC")'>2.0 D Q
- . N GMRCMSG
- . S GMRCMSG="**Version 2.2 of Medicine required to associate results with Consults**"
- . D EXAC^GMRCADC(GMRCMSG)
- . S GMRCQUT=1
- I $D(XQY0),$E(XQY0,1,2)="MC" G AR
- I '$D(GMRCO) D SEL^GMRCA2 I 'GMRCSEL G END
- I $D(VALM) D FULL^VALM1
- I '$D(GMRCO) S GMRCO=$O(^TMP("GMRCR",$J,"CS","AD",GMRCSEL,GMRCSEL,0))
- S GMRC(0)=^GMR(123,GMRCO,0)
- S GMRCPROC=$P(GMRC(0),"^",8)
- I GMRCPROC="" D G END
- . S GMRCMSG="No Procedure was ordered - Cannot Associate Results."
- . D EXAC^GMRCADC(GMRCMSG) S GMRCQIT=1
- I '$P(^GMR(123.3,+GMRCPROC,0),U,5) D I $G(GMRCQIT)=1 G END
- . D EXAC^GMRCADC("This procedure not configured for Medicine Resulting")
- . S GMRCQIT=1
- I $P(GMRC(0),"^",12)=1 D G END
- . S GMRCMSG="THIS ORDER HAS BEEN DISCONTINUED!"
- . D EXAC^GMRCADC(GMRCMSG) S GMRCQUT=1
- I +$P(GMRC(0),"^",15),$P(GMRC(0),U,15)["MCAR" D
- . S GMRCSR=$P(GMRC(0),"^",15)
- . S GMRCSR=U_$P(GMRCSR,";",2)_$P(GMRCSR,";")_",0)"
- . I '$D(@GMRCSR) D I $G(GMRCQIT)=1 Q
- .. S GMRCMSG="This request is currently associated with results "
- .. S GMRCMSG=GMRCMSG_"no longer available" D EXAC^GMRCADC(GMRCMSG),END
- .. S GMRCQIT=1
- .S X=$P(@GMRCSR,"^",1) D REGDTM^GMRCU S X1=X
- .S X=$P(^GMR(123,GMRCO,0),"^",7) D REGDTM^GMRCU
- .W !," Results entered on "_X1_" are associated "
- .W !," with this request ordered on "_X
- . S DIR(0)="YA",DIR("A")="Would you like to continue? "
- . S DIR("B")="No" D ^DIR I Y<1 S GMRCQIT=1 Q
- . Q
- I $G(GMRCQIT)=1 Q
- S MCROOT=$$GET1^DIQ(697.2,+$P(^GMR(123.3,+GMRCPROC,0),U,5),1)
- D RESULTS^GMRCMED(MCROOT,$P(^GMR(123,+GMRCO,0),U,2))
- I $D(^TMP("GMRCR",$J,"DT")) D EN^GMRCMER S VALMBCK="R",GMRCQIT=1
- I '$D(^TMP("GMRCR",$J,"DT"))&'($G(GMRCQIT)) D
- . N MSG
- . S MSG="No results are available to associate with this request."
- . D EXAC^GMRCADC(MSG)
- Q
- LKUP ;look up on procedure file using "C" cross-reference
- N Y,DIC
- S GMRCDIC="^"_GMRCGL_",""C"","_DFN_")" I '$D(@GMRCDIC) S GMRCMSG="No "_GMRCPRNM_" results available for "_$P(^DPT(DFN,0),"^") D EXAC^GMRCADC(GMRCMSG) G END
- S DIC="^"_GMRCGL_",",DIC(0)="XEZ",D="C",X=$P(^DPT(DFN,0),"^"),DIC("S")="I $P(^(0),U,2)=DFN" W !,"Results for "_$P(^DPT(DFN,0),"^")
- D MIX^DIC1 G:+Y<0 END
- S GMRCSR=+Y_";"_GMRCGL_",",GMRCSRDT=Y(0,0)
- N GMRCEND S GMRCEND=0 W ! S DIR(0)="Y",DIR("A")="Do you want to review these results first",DIR("B")="Y" D ^DIR K DIR I Y D G:GMRCEND END
- .W @IOF S GMRCSRS=GMRCSR D AREN^GMRCSLM3(GMRCO,GMRCSR),EN^GMRCMER S GMRCSR=GMRCSRS
- .I GMRCCT=1 S GMRCEND=1 Q
- .N DIR,DIROUT,DTOUT,DUOUT
- .W !! S DIR(0)="Y",DIR("A")="Are these the right results to be associated with the selected request",DIR("B")="N" D ^DIR K DIR S:$D(DIROUT)!$D(DTOUT)!(X="^") GMRCEND=1
- .I Y=0 K GMRCSR S GMRCEND=1
- I GMRCEND K GMRCEND G END
- I '$D(GMRCSR) K GMRCEND W ! G LKUP
- I '+GMRCSR G END
- ORSTS ;Check if status needs update to complete
- N ORSTS
- I $P(GMRC(0),"^",12)=2 W !,"This request is already completed, no updating performed for this request",!,"Press the <ENTER> key to EXIT " R X:DTIME G END
- W ! S DIR(0)="Y",DIR("A")="Shall I update the order status to complete",DIR("B")="N",DIR("?")="Type 'Y' for 'YES' or 'N' for 'NO' and press <ENTER> key." D ^DIR K DIR I $D(DTOUT)!$D(DIROUT)!$D(DUOUT) G END
- S ORSTS=$S(Y:2,1:9)
- I $P(^GMR(123,GMRCO,0),"^",12)=ORSTS&(+$P(^GMR(123,GMRCO,0),"^",15)) G END
- S GETPROV="Clinician responsible for results" D GETPROV^GMRCAU I '$D(GMRCORNP) S GMRCQIT="" G END
- S GMRCSVSS=GMRCSVCN D RESULT^GMRCR S GMRCSS=GMRCSVSS K GMRCSVSS,ORIFN
- S GMRCVP=$O(^ORD(101,"B","GMRCR "_GMRCPROC,0)) I GMRCVP]"" S GMRCVP=GMRCVP_";ORD(101," D AD^GMRCSLM1,INIT^GMRCSLM
- END ;
- K ORIFN,GMRCO,GMRCEND,GMRCGL,GMRCDIC,GMRCMSG,GMRCVP,DIC,D,GMRCSR,GMRCSRDT,GMRCSRS,GMRCTM,GMRCBM,X,X1,GETPROV
- K GMRCO,GMRC(0),GMRCSR,MCFILE,MCPROC,GMRCPROC,GMRCPRNM
- I $D(DTOUT)!$D(DIROUT) S GMRCQIT=""
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCAR 4607 printed Feb 18, 2025@23:11:29 Page 2
- GMRCAR ;SLC/DLT,JFR - Associate Results ;7/21/00 12:20
- +1 ;;3.0;CONSULT/REQUEST TRACKING;**1,15**;DEC 27, 1997
- AR ;Associate results with request
- +1 IF $DATA(IOTM)
- IF $DATA(IOBM)
- IF $DATA(IOSTBM)
- DO FULL^VALM1
- +2 IF '$DATA(GMRCSEL)
- DO SEL^GMRCA2
- IF $DATA(DTOUT)!$DATA(DIROUT)
- SET GMRCQIT=""
- QUIT
- +3 IF 'GMRCSEL
- GOTO END
- +4 SET GMRCO=$ORDER(^TMP("GMRCR",$JOB,"CS","AD",GMRCSEL,GMRCSEL,0))
- SET GMRC(0)=^GMR(123,GMRCO,0)
- +5 IF $PIECE(GMRC(0),"^",12)=1
- WRITE !!,"THIS ORDER HAS BEEN DISCONTINUED, PLEASE SELECT OR ADD ANOTHER ORDER!",!!
- GOTO END
- +6 SET GMRCQIT=""
- QUIT
- ARMED ;Entry to associate results with a consult/request
- +1 NEW GMRCQIT,GMRCQUT,GMRCPROC,GMRCSR,MCROOT,MCFILE,Y
- +2 IF '$$VERSION^XPDUTL("MC")
- Begin DoDot:1
- +3 NEW GMRCMSG
- +4 SET GMRCMSG="Medicine Package Not Installed. Can't Associate Results."
- +5 DO EXAC^GMRCADC(GMRCMSG)
- End DoDot:1
- QUIT
- +6 IF $$VERSION^XPDUTL("MC")'>2.0
- Begin DoDot:1
- +7 NEW GMRCMSG
- +8 SET GMRCMSG="**Version 2.2 of Medicine required to associate results with Consults**"
- +9 DO EXAC^GMRCADC(GMRCMSG)
- +10 SET GMRCQUT=1
- End DoDot:1
- QUIT
- +11 IF $DATA(XQY0)
- IF $EXTRACT(XQY0,1,2)="MC"
- GOTO AR
- +12 IF '$DATA(GMRCO)
- DO SEL^GMRCA2
- IF 'GMRCSEL
- GOTO END
- +13 IF $DATA(VALM)
- DO FULL^VALM1
- +14 IF '$DATA(GMRCO)
- SET GMRCO=$ORDER(^TMP("GMRCR",$JOB,"CS","AD",GMRCSEL,GMRCSEL,0))
- +15 SET GMRC(0)=^GMR(123,GMRCO,0)
- +16 SET GMRCPROC=$PIECE(GMRC(0),"^",8)
- +17 IF GMRCPROC=""
- Begin DoDot:1
- +18 SET GMRCMSG="No Procedure was ordered - Cannot Associate Results."
- +19 DO EXAC^GMRCADC(GMRCMSG)
- SET GMRCQIT=1
- End DoDot:1
- GOTO END
- +20 IF '$PIECE(^GMR(123.3,+GMRCPROC,0),U,5)
- Begin DoDot:1
- +21 DO EXAC^GMRCADC("This procedure not configured for Medicine Resulting")
- +22 SET GMRCQIT=1
- End DoDot:1
- IF $GET(GMRCQIT)=1
- GOTO END
- +23 IF $PIECE(GMRC(0),"^",12)=1
- Begin DoDot:1
- +24 SET GMRCMSG="THIS ORDER HAS BEEN DISCONTINUED!"
- +25 DO EXAC^GMRCADC(GMRCMSG)
- SET GMRCQUT=1
- End DoDot:1
- GOTO END
- +26 IF +$PIECE(GMRC(0),"^",15)
- IF $PIECE(GMRC(0),U,15)["MCAR"
- Begin DoDot:1
- +27 SET GMRCSR=$PIECE(GMRC(0),"^",15)
- +28 SET GMRCSR=U_$PIECE(GMRCSR,";",2)_$PIECE(GMRCSR,";")_",0)"
- +29 IF '$DATA(@GMRCSR)
- Begin DoDot:2
- +30 SET GMRCMSG="This request is currently associated with results "
- +31 SET GMRCMSG=GMRCMSG_"no longer available"
- DO EXAC^GMRCADC(GMRCMSG)
- DO END
- +32 SET GMRCQIT=1
- End DoDot:2
- IF $GET(GMRCQIT)=1
- QUIT
- +33 SET X=$PIECE(@GMRCSR,"^",1)
- DO REGDTM^GMRCU
- SET X1=X
- +34 SET X=$PIECE(^GMR(123,GMRCO,0),"^",7)
- DO REGDTM^GMRCU
- +35 WRITE !," Results entered on "_X1_" are associated "
- +36 WRITE !," with this request ordered on "_X
- +37 SET DIR(0)="YA"
- SET DIR("A")="Would you like to continue? "
- +38 SET DIR("B")="No"
- DO ^DIR
- IF Y<1
- SET GMRCQIT=1
- QUIT
- +39 QUIT
- End DoDot:1
- +40 IF $GET(GMRCQIT)=1
- QUIT
- +41 SET MCROOT=$$GET1^DIQ(697.2,+$PIECE(^GMR(123.3,+GMRCPROC,0),U,5),1)
- +42 DO RESULTS^GMRCMED(MCROOT,$PIECE(^GMR(123,+GMRCO,0),U,2))
- +43 IF $DATA(^TMP("GMRCR",$JOB,"DT"))
- DO EN^GMRCMER
- SET VALMBCK="R"
- SET GMRCQIT=1
- +44 IF '$DATA(^TMP("GMRCR",$JOB,"DT"))&'($GET(GMRCQIT))
- Begin DoDot:1
- +45 NEW MSG
- +46 SET MSG="No results are available to associate with this request."
- +47 DO EXAC^GMRCADC(MSG)
- End DoDot:1
- +48 QUIT
- LKUP ;look up on procedure file using "C" cross-reference
- +1 NEW Y,DIC
- +2 SET GMRCDIC="^"_GMRCGL_",""C"","_DFN_")"
- IF '$DATA(@GMRCDIC)
- SET GMRCMSG="No "_GMRCPRNM_" results available for "_$PIECE(^DPT(DFN,0),"^")
- DO EXAC^GMRCADC(GMRCMSG)
- GOTO END
- +3 SET DIC="^"_GMRCGL_","
- SET DIC(0)="XEZ"
- SET D="C"
- SET X=$PIECE(^DPT(DFN,0),"^")
- SET DIC("S")="I $P(^(0),U,2)=DFN"
- WRITE !,"Results for "_$PIECE(^DPT(DFN,0),"^")
- +4 DO MIX^DIC1
- if +Y<0
- GOTO END
- +5 SET GMRCSR=+Y_";"_GMRCGL_","
- SET GMRCSRDT=Y(0,0)
- +6 NEW GMRCEND
- SET GMRCEND=0
- WRITE !
- SET DIR(0)="Y"
- SET DIR("A")="Do you want to review these results first"
- SET DIR("B")="Y"
- DO ^DIR
- KILL DIR
- IF Y
- Begin DoDot:1
- +7 WRITE @IOF
- SET GMRCSRS=GMRCSR
- DO AREN^GMRCSLM3(GMRCO,GMRCSR)
- DO EN^GMRCMER
- SET GMRCSR=GMRCSRS
- +8 IF GMRCCT=1
- SET GMRCEND=1
- QUIT
- +9 NEW DIR,DIROUT,DTOUT,DUOUT
- +10 WRITE !!
- SET DIR(0)="Y"
- SET DIR("A")="Are these the right results to be associated with the selected request"
- SET DIR("B")="N"
- DO ^DIR
- KILL DIR
- if $DATA(DIROUT)!$DATA(DTOUT)!(X="^")
- SET GMRCEND=1
- +11 IF Y=0
- KILL GMRCSR
- SET GMRCEND=1
- End DoDot:1
- if GMRCEND
- GOTO END
- +12 IF GMRCEND
- KILL GMRCEND
- GOTO END
- +13 IF '$DATA(GMRCSR)
- KILL GMRCEND
- WRITE !
- GOTO LKUP
- +14 IF '+GMRCSR
- GOTO END
- ORSTS ;Check if status needs update to complete
- +1 NEW ORSTS
- +2 IF $PIECE(GMRC(0),"^",12)=2
- WRITE !,"This request is already completed, no updating performed for this request",!,"Press the <ENTER> key to EXIT "
- READ X:DTIME
- GOTO END
- +3 WRITE !
- SET DIR(0)="Y"
- SET DIR("A")="Shall I update the order status to complete"
- SET DIR("B")="N"
- SET DIR("?")="Type 'Y' for 'YES' or 'N' for 'NO' and press <ENTER> key."
- DO ^DIR
- KILL DIR
- IF $DATA(DTOUT)!$DATA(DIROUT)!$DATA(DUOUT)
- GOTO END
- +4 SET ORSTS=$SELECT(Y:2,1:9)
- +5 IF $PIECE(^GMR(123,GMRCO,0),"^",12)=ORSTS&(+$PIECE(^GMR(123,GMRCO,0),"^",15))
- GOTO END
- +6 SET GETPROV="Clinician responsible for results"
- DO GETPROV^GMRCAU
- IF '$DATA(GMRCORNP)
- SET GMRCQIT=""
- GOTO END
- +7 SET GMRCSVSS=GMRCSVCN
- DO RESULT^GMRCR
- SET GMRCSS=GMRCSVSS
- KILL GMRCSVSS,ORIFN
- +8 SET GMRCVP=$ORDER(^ORD(101,"B","GMRCR "_GMRCPROC,0))
- IF GMRCVP]""
- SET GMRCVP=GMRCVP_";ORD(101,"
- DO AD^GMRCSLM1
- DO INIT^GMRCSLM
- END ;
- +1 KILL ORIFN,GMRCO,GMRCEND,GMRCGL,GMRCDIC,GMRCMSG,GMRCVP,DIC,D,GMRCSR,GMRCSRDT,GMRCSRS,GMRCTM,GMRCBM,X,X1,GETPROV
- +2 KILL GMRCO,GMRC(0),GMRCSR,MCFILE,MCPROC,GMRCPROC,GMRCPRNM
- +3 IF $DATA(DTOUT)!$DATA(DIROUT)
- SET GMRCQIT=""
- +4 QUIT