GMRCASV1.m

GMRCASV1 ;SLC/JFR - HIERARCHY MGMT cont'd ; 01/10/02 21:34

 ;;3.0;CONSULT/REQUEST TRACKING;**18,15,23,22,42**;DEC 27, 1997

 ;

 ; This routine invokes IA #3252

 ;

 Q  ; don't start at the top

GUI(GMRCARR,GMRCSTRT,GMRCWHY,GMRCSYN,GMRCO) ;;return CSLT services for GUI

 ;Input:

 ; GMRCARR - passed in as the array to return results in

 ; GMRCSTRT- service name or ien to begin building from

 ; GMRCWHY - 0 for display, 1 for forwarding or ordering

 ; GMRCSYN - Boolean: 1=return synonyms, 0=do not

 ; GMRCO   - consult ien from file 123

 ;Output: Array formatted as follows-

 ;      svc ien^svc name or syn^parent^has children^svc usage

 ;

 N GMRCDG,GMRCGRP,GMRCTO

 ;Following line modified to accept the Name as well as the IEN for a Service, TDP - 2/9/2005

 S GMRCDG=$$FIND1^DIC(123.5,,"AX",GMRCSTRT,"B") I 'GMRCDG Q

 S GMRCTO=GMRCWHY

 D SERV1^GMRCASV I '$D(^TMP("GMRCSLIST",$J)) Q

 I '$G(GMRCSYN) G GUIQ ;M @GMRCARR=^TMP("GMRCSLIST",$J) Q  ;no synonyms needed

 N GMRC,GMRCSVC,GMRCS,NEXT,PIEC

 S GMRC=0,NEXT=$O(^TMP("GMRCSLIST",$J," "),-1)+1

 F  S GMRC=$O(^TMP("GMRCSLIST",$J,GMRC)) Q:'GMRC  Q:$P(^TMP("GMRCSLIST",$J,GMRC),U,5)="S"  D

 . I $P(^TMP("GMRCSLIST",$J,GMRC),U,5)=1 Q

 . S GMRCSVC=+^TMP("GMRCSLIST",$J,GMRC)

 . S GMRCS=0

 . F  S GMRCS=$O(^GMR(123.5,GMRCSVC,2,GMRCS)) Q:'GMRCS  D

 .. S PIEC(1)=GMRCSVC

 .. S PIEC(2)=$P(^GMR(123.5,GMRCSVC,0),U)

 .. S PIEC(2)=^GMR(123.5,GMRCSVC,2,GMRCS,0)_"  <"_PIEC(2)_">"

 .. S ^TMP("GMRCSLIST",$J,NEXT)=PIEC(1)_"^"_PIEC(2)_"^^^S"

 .. S NEXT=NEXT+1

 .. Q

 . Q

GUIQ M @GMRCARR=^TMP("GMRCSLIST",$J)

 K ^TMP("GMRCS",$J),^TMP("GMRCSLIST",$J)

 Q

 ;

PAGE(PG) ;print header and increment page

 S PG=PG+1

 W !,"Consult Hierarchy list",?30,$$HTE^XLFDT($H),?60,"Page: ",PG

 W !,$$REPEAT^XLFSTR("-",78)

 Q

 ;

QUEUE ; queue up the print

 N ZTRTN,ZTSK,ZTIO,ZTDTH,ZTDESC

 S ZTRTN="PRTLST^GMRCASV",ZTDESC="Consult Service Hierarchy List"

 S ZTIO=ION,ZTDTH=$H

 D ^%ZTLOAD

 I $G(ZTSK) W !,"Queued to Print, Task # ",ZTSK

 E  W !,"Sorry, Try again Later"

 Q

GMRCASV1  ;SLC/JFR - HIERARCHY MGMT cont'd ; 01/10/02 21:34

 +1       ;;3.0;CONSULT/REQUEST TRACKING;**18,15,23,22,42**;DEC 27, 1997

 +2       ;

 +3       ; This routine invokes IA #3252

 +4       ;

 +5       ; don't start at the top

           QUIT 

GUI(GMRCARR,GMRCSTRT,GMRCWHY,GMRCSYN,GMRCO) ;;return CSLT services for GUI

 +1       ;Input:

 +2       ; GMRCARR - passed in as the array to return results in

 +3       ; GMRCSTRT- service name or ien to begin building from

 +4       ; GMRCWHY - 0 for display, 1 for forwarding or ordering

 +5       ; GMRCSYN - Boolean: 1=return synonyms, 0=do not

 +6       ; GMRCO   - consult ien from file 123

 +7       ;Output: Array formatted as follows-

 +8       ;      svc ien^svc name or syn^parent^has children^svc usage

 +9       ;

 +10       NEW GMRCDG,GMRCGRP,GMRCTO

 +11      ;Following line modified to accept the Name as well as the IEN for a Service, TDP - 2/9/2005

 +12       SET GMRCDG=$$FIND1^DIC(123.5,,"AX",GMRCSTRT,"B")

           IF 'GMRCDG

               QUIT 

 +13       SET GMRCTO=GMRCWHY

 +14       DO SERV1^GMRCASV

           IF '$DATA(^TMP("GMRCSLIST",$JOB))

               QUIT 

 +15      ;M @GMRCARR=^TMP("GMRCSLIST",$J) Q  ;no synonyms needed

           IF '$GET(GMRCSYN)

               GOTO GUIQ

 +16       NEW GMRC,GMRCSVC,GMRCS,NEXT,PIEC

 +17       SET GMRC=0

           SET NEXT=$ORDER(^TMP("GMRCSLIST",$JOB," "),-1)+1

 +18       FOR 

               SET GMRC=$ORDER(^TMP("GMRCSLIST",$JOB,GMRC))

               IF 'GMRC

                   QUIT 

               IF $PIECE(^TMP("GMRCSLIST",$JOB,GMRC),U,5)="S"

                   QUIT 

               Begin DoDot:1

 +19               IF $PIECE(^TMP("GMRCSLIST",$JOB,GMRC),U,5)=1

                       QUIT 

 +20               SET GMRCSVC=+^TMP("GMRCSLIST",$JOB,GMRC)

 +21               SET GMRCS=0

 +22               FOR 

                       SET GMRCS=$ORDER(^GMR(123.5,GMRCSVC,2,GMRCS))

                       IF 'GMRCS

                           QUIT 

                       Begin DoDot:2

 +23                       SET PIEC(1)=GMRCSVC

 +24                       SET PIEC(2)=$PIECE(^GMR(123.5,GMRCSVC,0),U)

 +25                       SET PIEC(2)=^GMR(123.5,GMRCSVC,2,GMRCS,0)_"  <"_PIEC(2)_">"

 +26                       SET ^TMP("GMRCSLIST",$JOB,NEXT)=PIEC(1)_"^"_PIEC(2)_"^^^S"

 +27                       SET NEXT=NEXT+1

 +28                       QUIT 

                       End DoDot:2

 +29               QUIT 

               End DoDot:1

GUIQ       MERGE @GMRCARR=^TMP("GMRCSLIST",$JOB)

 +1        KILL ^TMP("GMRCS",$JOB),^TMP("GMRCSLIST",$JOB)

 +2        QUIT 

 +3       ;

PAGE(PG)  ;print header and increment page

 +1        SET PG=PG+1

 +2        WRITE !,"Consult Hierarchy list",?30,$$HTE^XLFDT($HOROLOG),?60,"Page: ",PG

 +3        WRITE !,$$REPEAT^XLFSTR("-",78)

 +4        QUIT 

 +5       ;

QUEUE     ; queue up the print

 +1        NEW ZTRTN,ZTSK,ZTIO,ZTDTH,ZTDESC

 +2        SET ZTRTN="PRTLST^GMRCASV"

           SET ZTDESC="Consult Service Hierarchy List"

 +3        SET ZTIO=ION

           SET ZTDTH=$HOROLOG

 +4        DO ^%ZTLOAD

 +5        IF $GET(ZTSK)

               WRITE !,"Queued to Print, Task # ",ZTSK

 +6       IF '$TEST

               WRITE !,"Sorry, Try again Later"

 +7        QUIT