- GMRCR ;SLC/DLT - Driver for reviewing patient consult/requests - Used by Medicine Package to link Consults to Medicine results ;9/18/98 16:26
- ;;3.0;CONSULT/REQUEST TRACKING;**1,5,46**;DEC 27, 1997;Build 23
- EN ;Entry point for medicine results entry by procedure or consult type
- ;Required variables:
- ; GMRCPRNM = name of procedure file with results.
- ; DFN = patient file (2) ien
- ;Optional variables:
- ; GMRCSR = variable pointer for results
- ; ORSTS = order status
- ; GMRCI = 0 or undefined, assume interactive
- ; 1, assume non-interactive - not operational currently
- ;Returned variables:
- ; ORIFN = Pointer to the consult order in file 100
- ; GMRCO = Pointer to the Request/Consultation entry in file 123.5
- ;
- K DTOUT,DUOUT,ORIFN,GMRCO,GMRCX
- I '$D(GMRCPNM) D DEM^GMRCU
- I $D(GMRCPRNM) S GMRC=$O(^ORD(101,"B","GMRCR "_GMRCPRNM,0)),GMRCTYPE="GMRCOR REQUEST"
- E I $D(GMRCPR) S GMRC=GMRCPR,GMRCTYPE="GMRCOR REQUEST"
- I $D(GMRCCT) S GMRC=GMRCCT,GMRCTYPE="GMRCOR CONSULT"
- I $D(GMRC)=1!($D(GMRC)=11),+GMRC D
- .S GMRCVP=GMRC_";ORD(101,",GMRCNM=$S($D(^ORD(101,GMRC,0)):$P(^(0),"^",2),1:"")
- .S GMRCSS=$P($G(^ORD(101,+GMRCVP,5)),"^"),GMRCSS=+GMRCSS
- EN1 ;Entry point for
- Q I 'GMRCSS D ASRV^GMRCASV D Q:GMRCEND S GMRCSS=+GMRCDG I 'GMRCDG S GMRCEND=1 K GMRCSS Q
- .I $D(DTOUT)!($D(DIROUT)) S GMRCEND=1 K DTOUT,DIROUT,DIRUT,DUOUT Q
- .Q
- E S GMRCDG=GMRCSS D SERV1^GMRCASV
- I '$D(ORTKG) S ORTKG=$$PACKAGE I ORTKG="" S GMRCMSG="Missing package entry for CONSULT/REQUEST TRACKING" D EXAC^GMRCADC(GMRCMSG) K GMRCMSG S GMRCEND=1 Q
- ;old code? D TEAM^GMRCASV
- S GMRCSSNM=$P(^GMR(123.5,GMRCSS,0),"^",1)
- ;old codeN GMRCQIT
- ;old code? S ORVP=DFN_";DPT(",GMRCGRP=0
- ;old code? K ^TMP("GMRCR",$J)
- K GMRCOER,GMRCQUT
- S GMRCEN=1
- D EN^GMRCMENU ; used to be D EN^GMRCACTM
- S GMRCOER=0
- D AD^GMRCSLM1 ; used to be D AD^GMRCRA
- D EN^VALM("GMRC CONSULT TRACKING")
- D KILL
- Q
- KILL ; Kill variables, but don't kill GMRCO and ORIFN if from MC option
- ;K VALMCNT,VALMBCK,VALMPGE
- ;K ^TMP("GMRCR",$J,"CS"),^TMP("GMRCS",$J)
- K X,Y,Z,DTOUT,DUOUT,DIROUT
- K GMRC,GMRCA,GMRCACT,GMRCACTM,GMRCAGE,GMRCCT,GMRCCTX,GMRCDG,GMRCDGT
- K GMRCDOB,GMRCDTM,GMRCGRP,GMRCH,GMRCHDR,GMRCIFN,GMRCLFG,GMRCNM,GMRCNPG
- K GMRCPNM,GMRCRB,GMRCWARD,GMRCSN,GMRCRPG,GMRCNPG,GMRCTITL,GMRCX,GMRCHDR,GMRCH,GMRCDTM
- K GMRCSTS,GMRCTYPE,GMRCVP,GMRCEND,GMRCTO,GMRCURG,GMRCL,GMRCDT,GMRCDIC
- K VA,VAIN,VAINDT,VADM,VAEL,VAPA,VAERR,VAROOT
- K O,OREND,ORINDX,ORNS,POP,SEX,W,XQORSPEW
- I $D(XQY0),$E(XQY0,1,2)="MC" S:'$D(GMRCO) (ORIFN,GMRCO)="" Q
- K ORIFN,GMRCO,GMRCSR
- Q
- RESULT ;Entry point to set up variable pointer to results and update OE/RR status
- Q
- Q:'$D(GMRCSR) Q:'$D(GMRCO) S (GMRCSS,GMRCSSNM,GMRCNM,GMRC,GMRCVP)=""
- S GMRCOM=0,GMR(0)=$S($D(^GMR(123,+GMRCO,0)):^(0),1:""),GMRCSS=$P(GMR(0),"^",5) I GMRCSS,$D(^GMR(123.5,GMRCSS,0)) S GMRCSSNM=$S($L($P(^GMR(123.5,GMRCSS,0),"^",9)):$P(^(0),"^",9),1:$P(^(0),"^"))
- S GMRCVP=$P(GMR(0),"^",8) I +GMRCVP S DIC="^"_$P(GMRCVP,";",2)_$P(GMRCVP,";")_",0)" I $L(DIC),$D(@DIC) S GMRCNM=@(DIC),GMRCNM=$P(GMRCNM,"^",2)
- I '$D(ORSTS) S ORSTS=6 ;Assume order entry status of active
- S GMRCA=$O(^GMR(123.1,"AC",+ORSTS,"")) I 'GMRCA S GMRCA=9
- S DIE=123,DA=GMRCO,DR="11////^S X=GMRCSR;8////^S X=ORSTS;9////^S X=GMRCA"
- L +^GMR(123,GMRCO):$S($G(DILOCKTM)>0:DILOCKTM,1:5) I '$T S GMRCMSG="Consult/Request Is Being Used By Another User.",GMRCMSG(1)="RESULT UPDATE WAS UNSUCCESSFUL! Try Again Later" D EXAC^GMRCADC(.GMRCMSG) K GMRCO,ORIFN,GMRCMSG D KILL Q
- D ^DIE K DIE,DA,DR
- L -^GMR(123,GMRCO) D AUDIT^GMRCP
- S:'$D(ORIFN) ORIFN=$P(^GMR(123,+GMRCO,0),"^",3)
- S GMRCORNP=$P(GMR(0),"^",14),GMRCTYPE=$P(GMR(0),"^",17)
- I $L($P(GMR(0),"^",14)),$P(GMR(0),"^",14)'=DUZ S GMRCADUZ($P(GMR(0),"^",14))=""
- I ORIFN D EN^GMRCHL7(DFN,GMRCO,$G(GMRCTYPE),$G(GMRCRB),"RE",GMRCORNP,$G(GMRCVSIT),.GMRCOM)
- K GMR,GMRCSS,GMRCORVP,GMRCVP,GMRCNM,DIC,GMRCPR
- Q
- ;
- PACKAGE() ; Returns the package entry number for 'CONSULT/REQUEST TRACKING"
- Q $$FIND1^DIC(9.4,,"QX","CONSULT/REQUEST TRACKING")
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCR 4043 printed Jan 18, 2025@02:48:16 Page 2
- GMRCR ;SLC/DLT - Driver for reviewing patient consult/requests - Used by Medicine Package to link Consults to Medicine results ;9/18/98 16:26
- +1 ;;3.0;CONSULT/REQUEST TRACKING;**1,5,46**;DEC 27, 1997;Build 23
- EN ;Entry point for medicine results entry by procedure or consult type
- +1 ;Required variables:
- +2 ; GMRCPRNM = name of procedure file with results.
- +3 ; DFN = patient file (2) ien
- +4 ;Optional variables:
- +5 ; GMRCSR = variable pointer for results
- +6 ; ORSTS = order status
- +7 ; GMRCI = 0 or undefined, assume interactive
- +8 ; 1, assume non-interactive - not operational currently
- +9 ;Returned variables:
- +10 ; ORIFN = Pointer to the consult order in file 100
- +11 ; GMRCO = Pointer to the Request/Consultation entry in file 123.5
- +12 ;
- +13 KILL DTOUT,DUOUT,ORIFN,GMRCO,GMRCX
- +14 IF '$DATA(GMRCPNM)
- DO DEM^GMRCU
- +15 IF $DATA(GMRCPRNM)
- SET GMRC=$ORDER(^ORD(101,"B","GMRCR "_GMRCPRNM,0))
- SET GMRCTYPE="GMRCOR REQUEST"
- +16 IF '$TEST
- IF $DATA(GMRCPR)
- SET GMRC=GMRCPR
- SET GMRCTYPE="GMRCOR REQUEST"
- +17 IF $DATA(GMRCCT)
- SET GMRC=GMRCCT
- SET GMRCTYPE="GMRCOR CONSULT"
- +18 IF $DATA(GMRC)=1!($DATA(GMRC)=11)
- IF +GMRC
- Begin DoDot:1
- +19 SET GMRCVP=GMRC_";ORD(101,"
- SET GMRCNM=$SELECT($DATA(^ORD(101,GMRC,0)):$PIECE(^(0),"^",2),1:"")
- +20 SET GMRCSS=$PIECE($GET(^ORD(101,+GMRCVP,5)),"^")
- SET GMRCSS=+GMRCSS
- End DoDot:1
- EN1 ;Entry point for
- +1 QUIT
- IF 'GMRCSS
- DO ASRV^GMRCASV
- Begin DoDot:1
- +2 IF $DATA(DTOUT)!($DATA(DIROUT))
- SET GMRCEND=1
- KILL DTOUT,DIROUT,DIRUT,DUOUT
- QUIT
- +3 QUIT
- End DoDot:1
- if GMRCEND
- QUIT
- SET GMRCSS=+GMRCDG
- IF 'GMRCDG
- SET GMRCEND=1
- KILL GMRCSS
- QUIT
- +4 IF '$TEST
- SET GMRCDG=GMRCSS
- DO SERV1^GMRCASV
- +5 IF '$DATA(ORTKG)
- SET ORTKG=$$PACKAGE
- IF ORTKG=""
- SET GMRCMSG="Missing package entry for CONSULT/REQUEST TRACKING"
- DO EXAC^GMRCADC(GMRCMSG)
- KILL GMRCMSG
- SET GMRCEND=1
- QUIT
- +6 ;old code? D TEAM^GMRCASV
- +7 SET GMRCSSNM=$PIECE(^GMR(123.5,GMRCSS,0),"^",1)
- +8 ;old codeN GMRCQIT
- +9 ;old code? S ORVP=DFN_";DPT(",GMRCGRP=0
- +10 ;old code? K ^TMP("GMRCR",$J)
- +11 KILL GMRCOER,GMRCQUT
- +12 SET GMRCEN=1
- +13 ; used to be D EN^GMRCACTM
- DO EN^GMRCMENU
- +14 SET GMRCOER=0
- +15 ; used to be D AD^GMRCRA
- DO AD^GMRCSLM1
- +16 DO EN^VALM("GMRC CONSULT TRACKING")
- +17 DO KILL
- +18 QUIT
- KILL ; Kill variables, but don't kill GMRCO and ORIFN if from MC option
- +1 ;K VALMCNT,VALMBCK,VALMPGE
- +2 ;K ^TMP("GMRCR",$J,"CS"),^TMP("GMRCS",$J)
- +3 KILL X,Y,Z,DTOUT,DUOUT,DIROUT
- +4 KILL GMRC,GMRCA,GMRCACT,GMRCACTM,GMRCAGE,GMRCCT,GMRCCTX,GMRCDG,GMRCDGT
- +5 KILL GMRCDOB,GMRCDTM,GMRCGRP,GMRCH,GMRCHDR,GMRCIFN,GMRCLFG,GMRCNM,GMRCNPG
- +6 KILL GMRCPNM,GMRCRB,GMRCWARD,GMRCSN,GMRCRPG,GMRCNPG,GMRCTITL,GMRCX,GMRCHDR,GMRCH,GMRCDTM
- +7 KILL GMRCSTS,GMRCTYPE,GMRCVP,GMRCEND,GMRCTO,GMRCURG,GMRCL,GMRCDT,GMRCDIC
- +8 KILL VA,VAIN,VAINDT,VADM,VAEL,VAPA,VAERR,VAROOT
- +9 KILL O,OREND,ORINDX,ORNS,POP,SEX,W,XQORSPEW
- +10 IF $DATA(XQY0)
- IF $EXTRACT(XQY0,1,2)="MC"
- if '$DATA(GMRCO)
- SET (ORIFN,GMRCO)=""
- QUIT
- +11 KILL ORIFN,GMRCO,GMRCSR
- +12 QUIT
- RESULT ;Entry point to set up variable pointer to results and update OE/RR status
- +1 QUIT
- +2 if '$DATA(GMRCSR)
- QUIT
- if '$DATA(GMRCO)
- QUIT
- SET (GMRCSS,GMRCSSNM,GMRCNM,GMRC,GMRCVP)=""
- +3 SET GMRCOM=0
- SET GMR(0)=$SELECT($DATA(^GMR(123,+GMRCO,0)):^(0),1:"")
- SET GMRCSS=$PIECE(GMR(0),"^",5)
- IF GMRCSS
- IF $DATA(^GMR(123.5,GMRCSS,0))
- SET GMRCSSNM=$SELECT($LENGTH($PIECE(^GMR(123.5,GMRCSS,0),"^",9)):$PIECE(^(0),"^",9),1:$PIECE(^(0),"^"))
- +4 SET GMRCVP=$PIECE(GMR(0),"^",8)
- IF +GMRCVP
- SET DIC="^"_$PIECE(GMRCVP,";",2)_$PIECE(GMRCVP,";")_",0)"
- IF $LENGTH(DIC)
- IF $DATA(@DIC)
- SET GMRCNM=@(DIC)
- SET GMRCNM=$PIECE(GMRCNM,"^",2)
- +5 ;Assume order entry status of active
- IF '$DATA(ORSTS)
- SET ORSTS=6
- +6 SET GMRCA=$ORDER(^GMR(123.1,"AC",+ORSTS,""))
- IF 'GMRCA
- SET GMRCA=9
- +7 SET DIE=123
- SET DA=GMRCO
- SET DR="11////^S X=GMRCSR;8////^S X=ORSTS;9////^S X=GMRCA"
- +8 LOCK +^GMR(123,GMRCO):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:5)
- IF '$TEST
- SET GMRCMSG="Consult/Request Is Being Used By Another User."
- SET GMRCMSG(1)="RESULT UPDATE WAS UNSUCCESSFUL! Try Again Later"
- DO EXAC^GMRCADC(.GMRCMSG)
- KILL GMRCO,ORIFN,GMRCMSG
- DO KILL
- QUIT
- +9 DO ^DIE
- KILL DIE,DA,DR
- +10 LOCK -^GMR(123,GMRCO)
- DO AUDIT^GMRCP
- +11 if '$DATA(ORIFN)
- SET ORIFN=$PIECE(^GMR(123,+GMRCO,0),"^",3)
- +12 SET GMRCORNP=$PIECE(GMR(0),"^",14)
- SET GMRCTYPE=$PIECE(GMR(0),"^",17)
- +13 IF $LENGTH($PIECE(GMR(0),"^",14))
- IF $PIECE(GMR(0),"^",14)'=DUZ
- SET GMRCADUZ($PIECE(GMR(0),"^",14))=""
- +14 IF ORIFN
- DO EN^GMRCHL7(DFN,GMRCO,$GET(GMRCTYPE),$GET(GMRCRB),"RE",GMRCORNP,$GET(GMRCVSIT),.GMRCOM)
- +15 KILL GMR,GMRCSS,GMRCORVP,GMRCVP,GMRCNM,DIC,GMRCPR
- +16 QUIT
- +17 ;
- PACKAGE() ; Returns the package entry number for 'CONSULT/REQUEST TRACKING"
- +1 QUIT $$FIND1^DIC(9.4,,"QX","CONSULT/REQUEST TRACKING")
- +2 ;