90 lines
3.9 KiB
Mathematica
90 lines
3.9 KiB
Mathematica
GMRCEDT2 ;SLC/JFR,DCM - RESUBMIT A CANCELLED CONSULT ;3/14/03 07:27
|
|
;;3.0;CONSULT/REQUEST TRACKING;**1,5,12,15,22,33**;DEC 27, 1997
|
|
EN(GMRCO,COMNO) ;entry point into the routine
|
|
;COMNO=CMDA from ^GMRCEDT2=comments array IEN from ^GMR(123,IEN,40,
|
|
;GMRCO=IEN of the consult from file 123
|
|
I $S($P(^GMR(123,GMRCO,0),"^",12)'=13:1,$D(GMRCRSUB):1,1:0) D Q
|
|
.S GMRCMSG="*** Consult Has Already Been Resubmitted ***"
|
|
.S GMRCMSG(1)="*** No Further Action Is Required Or Allowed ***"
|
|
.D EXAC^GMRCADC(.GMRCMSG)
|
|
.S:'$D(GMRCRSUB) GMRCRSUB=1
|
|
.Q
|
|
N MSG S MSG=$$EDRESOK(GMRCO)
|
|
I '+MSG D EXAC^GMRCADC($P(MSG,U,2)) Q
|
|
I '$$PDOK^GMRCEDT4(GMRCO) D Q
|
|
. D EXAC^GMRCADC("Can't resubmit!")
|
|
. S GMRCRSUB=1
|
|
. Q
|
|
I '$D(GMRCGUIF) W !,"Resubmitting Consult ... One moment please ..."
|
|
K ^TMP("GMRCSUB",$J) S ^TMP("GMRCSUB",$J)=0
|
|
I $D(GMRCEDT(1)) S ^TMP("GMRCSUB",$J,1)="GMRCSS^"_+GMRCEDT(1)
|
|
I $D(GMRCED(1)) D
|
|
. I $P(GMRCED(1),U)=$P(^GMR(123,+GMRCO,0),U,8) K GMRCED(1) Q
|
|
. S ^TMP("GMRCSUB",$J,2)="GMRCPROC^"_+GMRCED(1)_";GMR(123.3,"
|
|
I $D(GMRCED(2)) D
|
|
. I $P(GMRCED(2),U)=$P(^GMR(123,+GMRCO,0),U,18) K GMRCED(2) Q
|
|
. S ^TMP("GMRCSUB",$J,3)="GMRCION^"_$P(GMRCED(2),U)
|
|
I $D(GMRCED(3)) D
|
|
. I $P(GMRCED(3),U)=$P(^GMR(123,+GMRCO,0),U,9) K GMRCED(3) Q
|
|
. S ^TMP("GMRCSUB",$J,4)="GMRCURG^"_$P(GMRCED(3),U)
|
|
I $D(GMRCED(4)) D
|
|
. I $P(GMRCED(4),U)=$P(^GMR(123,+GMRCO,0),U,10) K GMRCED(4) Q
|
|
. S ^TMP("GMRCSUB",$J,5)="GMRCPL^"_$P(GMRCED(4),U)
|
|
I $D(GMRCED(5)) D
|
|
. I $P(GMRCED(5),U)=$P(^GMR(123,+GMRCO,0),U,11) K GMRCED(5) Q
|
|
. I '$L($P(GMRCED(5),U)) S $P(GMRCED(5),U)="@"
|
|
. S ^TMP("GMRCSUB",$J,6)="GMRCATN^"_$P(GMRCED(5),U)
|
|
I $D(GMRCED(6)) D
|
|
. I GMRCED(6)=$G(^GMR(123,+GMRCO,30)) K GMRCED(6) Q
|
|
. I $P(GMRCED(6),U)_" ("_$P(GMRCED(6),U,2)_")"=$G(^GMR(123,GMRCO,30)) K GMRCED(6) Q
|
|
. I '$L($P(GMRCED(6),U)) S $P(GMRCED(6),U,1,2)="@"
|
|
. I $L($P(GMRCED(6),U,2)),$P(GMRCED(6),U,2)'="@" D
|
|
.. S $P(GMRCED(6),U)=$P(GMRCED(6),U)_" ("_$P(GMRCED(6),U,2)_")"
|
|
. S ^TMP("GMRCSUB",$J,7)="GMRCDIAG^"_GMRCED(6)
|
|
I $D(^TMP("GMRCED",$J,20)) S ^TMP("GMRCSUB",$J,20)="GMRCRFQ^" D
|
|
. N ND S ND=0
|
|
. F S ND=$O(^TMP("GMRCED",$J,20,ND)) Q:'ND D
|
|
.. S ^TMP("GMRCSUB",$J,20,ND)=^TMP("GMRCED",$J,20,ND,0)
|
|
I $D(^TMP("GMRCED",$J,40)) S ^TMP("GMRCSUB",$J,40)="COMMENT^" D
|
|
. N ND S ND=0
|
|
. F S ND=$O(^TMP("GMRCED",$J,40,ND)) Q:'ND D
|
|
.. S ^TMP("GMRCSUB",$J,40,ND)=^TMP("GMRCED",$J,40,ND,0)
|
|
D FILE^GMRCGUIC(+GMRCO,$NAME(^TMP("GMRCSUB",$J)),1)
|
|
N GMRCADUZ S GMRCADUZ=""
|
|
S DFN=$P(^GMR(123,+GMRCO,0),"^",2),GMRCPROV=$P(^(0),"^",14)
|
|
S GMRCTYPE=$P(^GMR(123,+GMRCO,0),U,17),GMRCTRLC="XX",VISIT="",RMBED=""
|
|
S DIE="^GMR(123,",DA=+GMRCO,DR="8////^S X=5;9////^S X=11" D ^DIE
|
|
K DIE,DA,DR
|
|
S GMRCRSUB=1
|
|
S GMRCURG=$P(^GMR(123,+GMRCO,0),"^",9)
|
|
I +$P(^GMR(123,+GMRCO,0),"^",11) S GMRCADUZ($P(^(0),"^",11))=""
|
|
S GMRCSVC=$P(^GMR(123,+GMRCO,0),"^",5)
|
|
I +GMRCSVC D
|
|
. D EN^GMRCT(GMRCSVC)
|
|
S GMRCORTX="Resubmitted consult "_$$ORTX^GMRCAU(+GMRCO)_$S(+GMRCURG:" ("_$P(^ORD(101,+GMRCURG,0),"^",2)_")",1:"")
|
|
K GMRCFL,GMRCPROV,GMRCTYPE,GMRCTRLC,VISIT,RMBED,GMRCOM,GMRCURG
|
|
K GMRCSVC,GMRCORTX
|
|
Q
|
|
EDRESOK(GMRCDA) ;check cslt or proc to see if still resubmittable
|
|
; if procedure is inactive or no services, not resubmittable
|
|
; if service is grouper or disabled, not resubmittable
|
|
N MSG,GMRC
|
|
Q:'$D(^GMR(123,+$G(GMRCDA),0)) "0^Invalid Consult Number"
|
|
I $P($G(^GMR(123,+GMRCDA,12)),U,5)="F" D Q MSG
|
|
. S MSG="0^This inter-facility cconsult may only be resubmitted by the"
|
|
. S MSG=MSG_" ordering facility."
|
|
S GMRC(0)=^GMR(123,+GMRCDA,0)
|
|
I '$P(GMRC(0),U,8) D Q MSG
|
|
. I "19"[+$P(^GMR(123.5,+$P(GMRC(0),U,5),0),U,2) D Q
|
|
.. S MSG="0^The service for this Consult is no longer orderable."
|
|
. S MSG=1
|
|
S MSG=1
|
|
I "19"[+$P(^GMR(123.5,+$P(GMRC(0),U,5),0),U,2) S MSG=0
|
|
I '$L($$GET1^DIQ(123.3,+$P(GMRC(0),U,8),.01)) S MSG=0
|
|
I +$$GET1^DIQ(123.3,+$P(GMRC(0),U,8),.02) S MSG=0
|
|
I '$D(^GMR(123.3,+$P(GMRC(0),U,8),2,"B",+$P(GMRC(0),U,5))) S MSG=0
|
|
I MSG=0 D
|
|
. S MSG=MSG_"^This procedure may no longer be ordered or the service "
|
|
. S MSG=MSG_"may no longer perform it."
|
|
Q MSG
|