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
GMRCEDT2 ;SLC/JFR,DCM - RESUBMIT A CANCELLED CONSULT ;3/14/03 07:27
+1 ;;3.0;CONSULT/REQUEST TRACKING;**1,5,12,15,22,33**;DEC 27, 1997
EN(GMRCO,COMNO) ;entry point into the routine
+1 ;COMNO=CMDA from ^GMRCEDT2=comments array IEN from ^GMR(123,IEN,40,
+2 ;GMRCO=IEN of the consult from file 123
+3 IF $SELECT($PIECE(^GMR(123,GMRCO,0),"^",12)'=13:1,$DATA(GMRCRSUB):1,1:0)
Begin DoDot:1
+4 SET GMRCMSG="*** Consult Has Already Been Resubmitted ***"
+5 SET GMRCMSG(1)="*** No Further Action Is Required Or Allowed ***"
+6 DO EXAC^GMRCADC(.GMRCMSG)
+7 IF '$DATA(GMRCRSUB)
SET GMRCRSUB=1
+8 QUIT
End DoDot:1
QUIT
+9 NEW MSG
SET MSG=$$EDRESOK(GMRCO)
+10 IF '+MSG
DO EXAC^GMRCADC($PIECE(MSG,U,2))
QUIT
+11 IF '$$PDOK^GMRCEDT4(GMRCO)
Begin DoDot:1
+12 DO EXAC^GMRCADC("Can't resubmit!")
+13 SET GMRCRSUB=1
+14 QUIT
End DoDot:1
QUIT
+15 IF '$DATA(GMRCGUIF)
WRITE !,"Resubmitting Consult ... One moment please ..."
+16 KILL ^TMP("GMRCSUB",$JOB)
SET ^TMP("GMRCSUB",$JOB)=0
+17 IF $DATA(GMRCEDT(1))
SET ^TMP("GMRCSUB",$JOB,1)="GMRCSS^"_+GMRCEDT(1)
+18 IF $DATA(GMRCED(1))
Begin DoDot:1
+19 IF $PIECE(GMRCED(1),U)=$PIECE(^GMR(123,+GMRCO,0),U,8)
KILL GMRCED(1)
QUIT
+20 SET ^TMP("GMRCSUB",$JOB,2)="GMRCPROC^"_+GMRCED(1)_";GMR(123.3,"
End DoDot:1
+21 IF $DATA(GMRCED(2))
Begin DoDot:1
+22 IF $PIECE(GMRCED(2),U)=$PIECE(^GMR(123,+GMRCO,0),U,18)
KILL GMRCED(2)
QUIT
+23 SET ^TMP("GMRCSUB",$JOB,3)="GMRCION^"_$PIECE(GMRCED(2),U)
End DoDot:1
+24 IF $DATA(GMRCED(3))
Begin DoDot:1
+25 IF $PIECE(GMRCED(3),U)=$PIECE(^GMR(123,+GMRCO,0),U,9)
KILL GMRCED(3)
QUIT
+26 SET ^TMP("GMRCSUB",$JOB,4)="GMRCURG^"_$PIECE(GMRCED(3),U)
End DoDot:1
+27 IF $DATA(GMRCED(4))
Begin DoDot:1
+28 IF $PIECE(GMRCED(4),U)=$PIECE(^GMR(123,+GMRCO,0),U,10)
KILL GMRCED(4)
QUIT
+29 SET ^TMP("GMRCSUB",$JOB,5)="GMRCPL^"_$PIECE(GMRCED(4),U)
End DoDot:1
+30 IF $DATA(GMRCED(5))
Begin DoDot:1
+31 IF $PIECE(GMRCED(5),U)=$PIECE(^GMR(123,+GMRCO,0),U,11)
KILL GMRCED(5)
QUIT
+32 IF '$LENGTH($PIECE(GMRCED(5),U))
SET $PIECE(GMRCED(5),U)="@"
+33 SET ^TMP("GMRCSUB",$JOB,6)="GMRCATN^"_$PIECE(GMRCED(5),U)
End DoDot:1
+34 IF $DATA(GMRCED(6))
Begin DoDot:1
+35 IF GMRCED(6)=$GET(^GMR(123,+GMRCO,30))
KILL GMRCED(6)
QUIT
+36 IF $PIECE(GMRCED(6),U)_" ("_$PIECE(GMRCED(6),U,2)_")"=$GET(^GMR(123,GMRCO,30))
KILL GMRCED(6)
QUIT
+37 IF '$LENGTH($PIECE(GMRCED(6),U))
SET $PIECE(GMRCED(6),U,1,2)="@"
+38 IF $LENGTH($PIECE(GMRCED(6),U,2))
IF $PIECE(GMRCED(6),U,2)'="@"
Begin DoDot:2
+39 SET $PIECE(GMRCED(6),U)=$PIECE(GMRCED(6),U)_" ("_$PIECE(GMRCED(6),U,2)_")"
End DoDot:2
+40 SET ^TMP("GMRCSUB",$JOB,7)="GMRCDIAG^"_GMRCED(6)
End DoDot:1
+41 IF $DATA(^TMP("GMRCED",$JOB,20))
SET ^TMP("GMRCSUB",$JOB,20)="GMRCRFQ^"
Begin DoDot:1
+42 NEW ND
SET ND=0
+43 FOR
SET ND=$ORDER(^TMP("GMRCED",$JOB,20,ND))
IF 'ND
QUIT
Begin DoDot:2
+44 SET ^TMP("GMRCSUB",$JOB,20,ND)=^TMP("GMRCED",$JOB,20,ND,0)
End DoDot:2
End DoDot:1
+45 IF $DATA(^TMP("GMRCED",$JOB,40))
SET ^TMP("GMRCSUB",$JOB,40)="COMMENT^"
Begin DoDot:1
+46 NEW ND
SET ND=0
+47 FOR
SET ND=$ORDER(^TMP("GMRCED",$JOB,40,ND))
IF 'ND
QUIT
Begin DoDot:2
+48 SET ^TMP("GMRCSUB",$JOB,40,ND)=^TMP("GMRCED",$JOB,40,ND,0)
End DoDot:2
End DoDot:1
+49 DO FILE^GMRCGUIC(+GMRCO,$NAME(^TMP("GMRCSUB",$JOB)),1)
+50 NEW GMRCADUZ
SET GMRCADUZ=""
+51 SET DFN=$PIECE(^GMR(123,+GMRCO,0),"^",2)
SET GMRCPROV=$PIECE(^(0),"^",14)
+52 SET GMRCTYPE=$PIECE(^GMR(123,+GMRCO,0),U,17)
SET GMRCTRLC="XX"
SET VISIT=""
SET RMBED=""
+53 SET DIE="^GMR(123,"
SET DA=+GMRCO
SET DR="8////^S X=5;9////^S X=11"
DO ^DIE
+54 KILL DIE,DA,DR
+55 SET GMRCRSUB=1
+56 SET GMRCURG=$PIECE(^GMR(123,+GMRCO,0),"^",9)
+57 IF +$PIECE(^GMR(123,+GMRCO,0),"^",11)
SET GMRCADUZ($PIECE(^(0),"^",11))=""
+58 SET GMRCSVC=$PIECE(^GMR(123,+GMRCO,0),"^",5)
+59 IF +GMRCSVC
Begin DoDot:1
+60 DO EN^GMRCT(GMRCSVC)
End DoDot:1
+61 SET GMRCORTX="Resubmitted consult "_$$ORTX^GMRCAU(+GMRCO)_$SELECT(+GMRCURG:" ("_$PIECE(^ORD(101,+GMRCURG,0),"^",2)_")",1:"")
+62 KILL GMRCFL,GMRCPROV,GMRCTYPE,GMRCTRLC,VISIT,RMBED,GMRCOM,GMRCURG
+63 KILL GMRCSVC,GMRCORTX
+64 QUIT
EDRESOK(GMRCDA) ;check cslt or proc to see if still resubmittable
+1 ; if procedure is inactive or no services, not resubmittable
+2 ; if service is grouper or disabled, not resubmittable
+3 NEW MSG,GMRC
+4 IF '$DATA(^GMR(123,+$GET(GMRCDA),0))
QUIT "0^Invalid Consult Number"
+5 IF $PIECE($GET(^GMR(123,+GMRCDA,12)),U,5)="F"
Begin DoDot:1
+6 SET MSG="0^This inter-facility cconsult may only be resubmitted by the"
+7 SET MSG=MSG_" ordering facility."
End DoDot:1
QUIT MSG
+8 SET GMRC(0)=^GMR(123,+GMRCDA,0)
+9 IF '$PIECE(GMRC(0),U,8)
Begin DoDot:1
+10 IF "19"[+$PIECE(^GMR(123.5,+$PIECE(GMRC(0),U,5),0),U,2)
Begin DoDot:2
+11 SET MSG="0^The service for this Consult is no longer orderable."
End DoDot:2
QUIT
+12 SET MSG=1
End DoDot:1
QUIT MSG
+13 SET MSG=1
+14 IF "19"[+$PIECE(^GMR(123.5,+$PIECE(GMRC(0),U,5),0),U,2)
SET MSG=0
+15 IF '$LENGTH($$GET1^DIQ(123.3,+$PIECE(GMRC(0),U,8),.01))
SET MSG=0
+16 IF +$$GET1^DIQ(123.3,+$PIECE(GMRC(0),U,8),.02)
SET MSG=0
+17 IF '$DATA(^GMR(123.3,+$PIECE(GMRC(0),U,8),2,"B",+$PIECE(GMRC(0),U,5)))
SET MSG=0
+18 IF MSG=0
Begin DoDot:1
+19 SET MSG=MSG_"^This procedure may no longer be ordered or the service "
+20 SET MSG=MSG_"may no longer perform it."
End DoDot:1
+21 QUIT MSG
