source: WorldVistAEHR/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCEDT2.m@ 861

Last change on this file since 861 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.9 KB
Line 
1GMRCEDT2 ;SLC/JFR,DCM - RESUBMIT A CANCELLED CONSULT ;3/14/03 07:27
2 ;;3.0;CONSULT/REQUEST TRACKING;**1,5,12,15,22,33**;DEC 27, 1997
3EN(GMRCO,COMNO) ;entry point into the routine
4 ;COMNO=CMDA from ^GMRCEDT2=comments array IEN from ^GMR(123,IEN,40,
5 ;GMRCO=IEN of the consult from file 123
6 I $S($P(^GMR(123,GMRCO,0),"^",12)'=13:1,$D(GMRCRSUB):1,1:0) D Q
7 .S GMRCMSG="*** Consult Has Already Been Resubmitted ***"
8 .S GMRCMSG(1)="*** No Further Action Is Required Or Allowed ***"
9 .D EXAC^GMRCADC(.GMRCMSG)
10 .S:'$D(GMRCRSUB) GMRCRSUB=1
11 .Q
12 N MSG S MSG=$$EDRESOK(GMRCO)
13 I '+MSG D EXAC^GMRCADC($P(MSG,U,2)) Q
14 I '$$PDOK^GMRCEDT4(GMRCO) D Q
15 . D EXAC^GMRCADC("Can't resubmit!")
16 . S GMRCRSUB=1
17 . Q
18 I '$D(GMRCGUIF) W !,"Resubmitting Consult ... One moment please ..."
19 K ^TMP("GMRCSUB",$J) S ^TMP("GMRCSUB",$J)=0
20 I $D(GMRCEDT(1)) S ^TMP("GMRCSUB",$J,1)="GMRCSS^"_+GMRCEDT(1)
21 I $D(GMRCED(1)) D
22 . I $P(GMRCED(1),U)=$P(^GMR(123,+GMRCO,0),U,8) K GMRCED(1) Q
23 . S ^TMP("GMRCSUB",$J,2)="GMRCPROC^"_+GMRCED(1)_";GMR(123.3,"
24 I $D(GMRCED(2)) D
25 . I $P(GMRCED(2),U)=$P(^GMR(123,+GMRCO,0),U,18) K GMRCED(2) Q
26 . S ^TMP("GMRCSUB",$J,3)="GMRCION^"_$P(GMRCED(2),U)
27 I $D(GMRCED(3)) D
28 . I $P(GMRCED(3),U)=$P(^GMR(123,+GMRCO,0),U,9) K GMRCED(3) Q
29 . S ^TMP("GMRCSUB",$J,4)="GMRCURG^"_$P(GMRCED(3),U)
30 I $D(GMRCED(4)) D
31 . I $P(GMRCED(4),U)=$P(^GMR(123,+GMRCO,0),U,10) K GMRCED(4) Q
32 . S ^TMP("GMRCSUB",$J,5)="GMRCPL^"_$P(GMRCED(4),U)
33 I $D(GMRCED(5)) D
34 . I $P(GMRCED(5),U)=$P(^GMR(123,+GMRCO,0),U,11) K GMRCED(5) Q
35 . I '$L($P(GMRCED(5),U)) S $P(GMRCED(5),U)="@"
36 . S ^TMP("GMRCSUB",$J,6)="GMRCATN^"_$P(GMRCED(5),U)
37 I $D(GMRCED(6)) D
38 . I GMRCED(6)=$G(^GMR(123,+GMRCO,30)) K GMRCED(6) Q
39 . I $P(GMRCED(6),U)_" ("_$P(GMRCED(6),U,2)_")"=$G(^GMR(123,GMRCO,30)) K GMRCED(6) Q
40 . I '$L($P(GMRCED(6),U)) S $P(GMRCED(6),U,1,2)="@"
41 . I $L($P(GMRCED(6),U,2)),$P(GMRCED(6),U,2)'="@" D
42 .. S $P(GMRCED(6),U)=$P(GMRCED(6),U)_" ("_$P(GMRCED(6),U,2)_")"
43 . S ^TMP("GMRCSUB",$J,7)="GMRCDIAG^"_GMRCED(6)
44 I $D(^TMP("GMRCED",$J,20)) S ^TMP("GMRCSUB",$J,20)="GMRCRFQ^" D
45 . N ND S ND=0
46 . F S ND=$O(^TMP("GMRCED",$J,20,ND)) Q:'ND D
47 .. S ^TMP("GMRCSUB",$J,20,ND)=^TMP("GMRCED",$J,20,ND,0)
48 I $D(^TMP("GMRCED",$J,40)) S ^TMP("GMRCSUB",$J,40)="COMMENT^" D
49 . N ND S ND=0
50 . F S ND=$O(^TMP("GMRCED",$J,40,ND)) Q:'ND D
51 .. S ^TMP("GMRCSUB",$J,40,ND)=^TMP("GMRCED",$J,40,ND,0)
52 D FILE^GMRCGUIC(+GMRCO,$NAME(^TMP("GMRCSUB",$J)),1)
53 N GMRCADUZ S GMRCADUZ=""
54 S DFN=$P(^GMR(123,+GMRCO,0),"^",2),GMRCPROV=$P(^(0),"^",14)
55 S GMRCTYPE=$P(^GMR(123,+GMRCO,0),U,17),GMRCTRLC="XX",VISIT="",RMBED=""
56 S DIE="^GMR(123,",DA=+GMRCO,DR="8////^S X=5;9////^S X=11" D ^DIE
57 K DIE,DA,DR
58 S GMRCRSUB=1
59 S GMRCURG=$P(^GMR(123,+GMRCO,0),"^",9)
60 I +$P(^GMR(123,+GMRCO,0),"^",11) S GMRCADUZ($P(^(0),"^",11))=""
61 S GMRCSVC=$P(^GMR(123,+GMRCO,0),"^",5)
62 I +GMRCSVC D
63 . D EN^GMRCT(GMRCSVC)
64 S GMRCORTX="Resubmitted consult "_$$ORTX^GMRCAU(+GMRCO)_$S(+GMRCURG:" ("_$P(^ORD(101,+GMRCURG,0),"^",2)_")",1:"")
65 K GMRCFL,GMRCPROV,GMRCTYPE,GMRCTRLC,VISIT,RMBED,GMRCOM,GMRCURG
66 K GMRCSVC,GMRCORTX
67 Q
68EDRESOK(GMRCDA) ;check cslt or proc to see if still resubmittable
69 ; if procedure is inactive or no services, not resubmittable
70 ; if service is grouper or disabled, not resubmittable
71 N MSG,GMRC
72 Q:'$D(^GMR(123,+$G(GMRCDA),0)) "0^Invalid Consult Number"
73 I $P($G(^GMR(123,+GMRCDA,12)),U,5)="F" D Q MSG
74 . S MSG="0^This inter-facility cconsult may only be resubmitted by the"
75 . S MSG=MSG_" ordering facility."
76 S GMRC(0)=^GMR(123,+GMRCDA,0)
77 I '$P(GMRC(0),U,8) D Q MSG
78 . I "19"[+$P(^GMR(123.5,+$P(GMRC(0),U,5),0),U,2) D Q
79 .. S MSG="0^The service for this Consult is no longer orderable."
80 . S MSG=1
81 S MSG=1
82 I "19"[+$P(^GMR(123.5,+$P(GMRC(0),U,5),0),U,2) S MSG=0
83 I '$L($$GET1^DIQ(123.3,+$P(GMRC(0),U,8),.01)) S MSG=0
84 I +$$GET1^DIQ(123.3,+$P(GMRC(0),U,8),.02) S MSG=0
85 I '$D(^GMR(123.3,+$P(GMRC(0),U,8),2,"B",+$P(GMRC(0),U,5))) S MSG=0
86 I MSG=0 D
87 . S MSG=MSG_"^This procedure may no longer be ordered or the service "
88 . S MSG=MSG_"may no longer perform it."
89 Q MSG
Note: See TracBrowser for help on using the repository browser.