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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCASV1 2036 printed Oct 16, 2024@17:46:01 Page 2
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
