GMRCPS.m

GMRCPS ;SLC/KCM,DLT -Select Service/specialty to send Consult to ;5/20/98  14:20

 ;;3.0;CONSULT/REQUEST TRACKING;**1**;DEC 27, 1997

ASRV W ! D SERV D:GMRCDG SERV1

 Q

SERV ;Select from Hierarchy of services defined in 123.5

 K X N GMRC1 S GMRCSTXT="Service/Specialty",GMRCSTXT(0)="ALL SERVICES",GMRCDG=0,GMRC1=0

 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

 I 'GMRCDG S GMRCACT("D")="Redisplay Screen"

 K GMRCSTXT,DUOUT,DIROUT Q

SERV1 ;

 S GMRCBUF=GMRCDG

 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))

 I $P(^GMR(123.5,GMRCBUF,0),"^",1)'="ALL SERVICES"

 K GMRCDG,GMRCSEQ,GMRCBUF Q

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

 I $P(Y(0),"^",2)=1 S GMRCSTXT(0)=Y(0,0),GMRCDG=+Y,GMRC1=1 D LSRV1 Q

 S:+Y>0 GMRCDG=+Y

 Q

LSRV S GMRC1=0,GMRCDG=$O(^GMR(123.5,"B",GMRCSTXT(0),0)) Q:'GMRCDG

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

 .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)

 ..I $Y>(IOSL-4) D READ^GMRCASV W:'$D(DUOUT) @IOF

 I X["??" S GMRCSTXT(0)="ALL SERVICES",GMRCSEL="DISP" W @IOF D EN^GMRCASV

 S GMRCDG=0 I GMRCSTXT(0)'="ALL SERVICES" S GMRCSTXT(0)="ALL SERVICES"

 K DUOUT,DIROUT W !

 Q

GMRCPS    ;SLC/KCM,DLT -Select Service/specialty to send Consult to ;5/20/98  14:20

 +1       ;;3.0;CONSULT/REQUEST TRACKING;**1**;DEC 27, 1997

ASRV       WRITE !

           DO SERV

           IF GMRCDG

               DO SERV1

 +1        QUIT 

SERV      ;Select from Hierarchy of services defined in 123.5

 +1        KILL X

           NEW GMRC1

           SET GMRCSTXT="Service/Specialty"

           SET GMRCSTXT(0)="ALL SERVICES"

           SET GMRCDG=0

           SET GMRC1=0

 +2        FOR 

               WRITE !,"Select 'TO' Service/Specialty: "

               READ X:DTIME

               IF '$LENGTH(X)&(GMRC1=0)

                   SET X="^"

               IF X["^^"

                   SET DIROUT=1

               IF X["^"

                   QUIT 

               IF GMRC1=1&('$LENGTH(X))

                   SET X="?"

               IF GMRC1=1

                   SET GMRC1=0

               DO @$SELECT(X["?":"LSRV",1:"LKUP")

               IF GMRCDG

                   SET GMRCDGT=GMRCDG

                   QUIT 

 +3        IF 'GMRCDG

               SET GMRCACT("D")="Redisplay Screen"

 +4        KILL GMRCSTXT,DUOUT,DIROUT

           QUIT 

SERV1     ;

 +1        SET GMRCBUF=GMRCDG

 +2        IF GMRCBUF>0

               KILL GMRCGRP

               SET GMRCSEL="BILD"

               DO EN^GMRCASV

               SET GMRCGRP("NAM")=^GMR(123.5,GMRCBUF,0)

               SET GMRCGRP("ROOT")=GMRCBUF

               SET GMRCGRP("NAM")=$SELECT($LENGTH($PIECE(GMRCGRP("NAM"),"^",3)):$PIECE(GMRCGRP("NAM"),"^",3),1:$EXTRACT($PIECE(GMRCGRP("NAM"),"^"),1,5))

 +3        IF $PIECE(^GMR(123.5,GMRCBUF,0),"^",1)'="ALL SERVICES"

 +4        KILL GMRCDG,GMRCSEQ,GMRCBUF

           QUIT 

LKUP       SET DIC="^GMR(123.5,"

           SET DIC(0)="MNEQZ"

           SET DIC("W")="W ""   "",$P(Y,""^"",2)"

           SET DIC("S")="I +$P(^(0),U,2)<2"

           DO ^DIC

           KILL DIC

           IF '$DATA(Y(0))

               DO LSRV

               QUIT 

 +1        IF $PIECE(Y(0),"^",2)=1

               SET GMRCSTXT(0)=Y(0,0)

               SET GMRCDG=+Y

               SET GMRC1=1

               DO LSRV1

               QUIT 

 +2        IF +Y>0

               SET GMRCDG=+Y

 +3        QUIT 

LSRV       SET GMRC1=0

           SET GMRCDG=$ORDER(^GMR(123.5,"B",GMRCSTXT(0),0))

           IF 'GMRCDG

               QUIT 

LSRV1      IF X'["??"

               WRITE @IOF,GMRCSTXT(0)

               FOR I=0:0

                   SET I=$ORDER(^GMR(123.5,GMRCDG,10,I))

                   IF I'>0

                       QUIT 

                   IF $DATA(DUOUT)

                       QUIT 

                   Begin DoDot:1

 +1                    IF $DATA(^GMR(123.5,GMRCDG,10,I,0))

                           Begin DoDot:2

 +2                            IF $Y>(IOSL-4)

                                   DO READ^GMRCASV

                                   IF '$DATA(DUOUT)

                                       WRITE @IOF

                           End DoDot:2

                           IF $DATA(DUOUT)

                               QUIT 

                           IF $DATA(^GMR(123.5,+^(0),0))

                               IF $PIECE(^GMR(123.5,+^GMR(123.5,GMRCDG,10,I,0),0),U,2)<9

                                   WRITE !,?2,$PIECE(^(0),U)

                   End DoDot:1

 +3        IF X["??"

               SET GMRCSTXT(0)="ALL SERVICES"

               SET GMRCSEL="DISP"

               WRITE @IOF

               DO EN^GMRCASV

 +4        SET GMRCDG=0

           IF GMRCSTXT(0)'="ALL SERVICES"

               SET GMRCSTXT(0)="ALL SERVICES"

 +5        KILL DUOUT,DIROUT

           WRITE !

 +6        QUIT