| 1 | GMRCPS ;SLC/KCM,DLT -Select Service/specialty to send Consult to ;5/20/98 14:20
|
|---|
| 2 | ;;3.0;CONSULT/REQUEST TRACKING;**1**;DEC 27, 1997
|
|---|
| 3 | ASRV W ! D SERV D:GMRCDG SERV1
|
|---|
| 4 | Q
|
|---|
| 5 | SERV ;Select from Hierarchy of services defined in 123.5
|
|---|
| 6 | K X N GMRC1 S GMRCSTXT="Service/Specialty",GMRCSTXT(0)="ALL SERVICES",GMRCDG=0,GMRC1=0
|
|---|
| 7 | F W !,"Select 'TO' Service/Specialty: " R X:DTIME S:'$L(X)&(GMRC1=0) X="^" S:X["^^" DIROUT=1 Q:X["^" S:GMRC1=1&('$L(X)) X="?" S:GMRC1=1 GMRC1=0 D @$S(X["?":"LSRV",1:"LKUP") I GMRCDG S GMRCDGT=GMRCDG Q
|
|---|
| 8 | I 'GMRCDG S GMRCACT("D")="Redisplay Screen"
|
|---|
| 9 | K GMRCSTXT,DUOUT,DIROUT Q
|
|---|
| 10 | SERV1 ;
|
|---|
| 11 | S GMRCBUF=GMRCDG
|
|---|
| 12 | I GMRCBUF>0 K GMRCGRP S GMRCSEL="BILD" D EN^GMRCASV S GMRCGRP("NAM")=^GMR(123.5,GMRCBUF,0),GMRCGRP("ROOT")=GMRCBUF,GMRCGRP("NAM")=$S($L($P(GMRCGRP("NAM"),"^",3)):$P(GMRCGRP("NAM"),"^",3),1:$E($P(GMRCGRP("NAM"),"^"),1,5))
|
|---|
| 13 | I $P(^GMR(123.5,GMRCBUF,0),"^",1)'="ALL SERVICES"
|
|---|
| 14 | K GMRCDG,GMRCSEQ,GMRCBUF Q
|
|---|
| 15 | LKUP S DIC="^GMR(123.5,",DIC(0)="MNEQZ",DIC("W")="W "" "",$P(Y,""^"",2)",DIC("S")="I +$P(^(0),U,2)<2" D ^DIC K DIC I '$D(Y(0)) D LSRV Q
|
|---|
| 16 | I $P(Y(0),"^",2)=1 S GMRCSTXT(0)=Y(0,0),GMRCDG=+Y,GMRC1=1 D LSRV1 Q
|
|---|
| 17 | S:+Y>0 GMRCDG=+Y
|
|---|
| 18 | Q
|
|---|
| 19 | LSRV S GMRC1=0,GMRCDG=$O(^GMR(123.5,"B",GMRCSTXT(0),0)) Q:'GMRCDG
|
|---|
| 20 | LSRV1 I X'["??" W @IOF,GMRCSTXT(0) F I=0:0 S I=$O(^GMR(123.5,GMRCDG,10,I)) Q:I'>0 Q:$D(DUOUT) D
|
|---|
| 21 | .I $D(^GMR(123.5,GMRCDG,10,I,0)) D Q:$D(DUOUT) I $D(^GMR(123.5,+^(0),0)),$P(^GMR(123.5,+^GMR(123.5,GMRCDG,10,I,0),0),U,2)<9 W !,?2,$P(^(0),U)
|
|---|
| 22 | ..I $Y>(IOSL-4) D READ^GMRCASV W:'$D(DUOUT) @IOF
|
|---|
| 23 | I X["??" S GMRCSTXT(0)="ALL SERVICES",GMRCSEL="DISP" W @IOF D EN^GMRCASV
|
|---|
| 24 | S GMRCDG=0 I GMRCSTXT(0)'="ALL SERVICES" S GMRCSTXT(0)="ALL SERVICES"
|
|---|
| 25 | K DUOUT,DIROUT W !
|
|---|
| 26 | Q
|
|---|
