GMRCNOTF ;SLC/JFR - NOTIFICATION RECIPIENT UTILITIES; 7/31/99 21:58
;;3.0;CONSULT/REQUEST TRACKING;**11**;DEC 27, 1997
EN ; -- main entry point for GMRC NOTIFICATION RECIPS
N GMRCSV
D SELSS Q:'$D(GMRCSV)
D INIT
D EN^VALM("GMRC NOTIFICATION RECIPS")
Q
;
SELSS ; select new service
N DIR,X,Y,DIRUT,DUOUT,DTOUT
D FULL^VALM1
S DIR(0)="PO^123.5:EMQ",DIR("A")="Select Service"
D ^DIR
I $D(DIRUT) Q
S GMRCSV=+Y
K ^TMP("GMRCNOTF",$J)
Q
;
HDR ; -- header code
S VALMHDR(1)="Notification Recipients for: "
S VALMHDR(1)=VALMHDR(1)_$P(^GMR(123.5,+GMRCSV,0),U)
Q
;
INIT ; -- init variables and list array
N GMRCADUZ,LINE,GMRCI,PERS
D EN^GMRCT(+GMRCSV,,1)
I '$D(GMRCADUZ) S ^TMP("GMRCNOTF",$J,1,0)="No notification recipients"
S GMRCI=0,LINE=1
F S GMRCI=$O(GMRCADUZ(GMRCI)) Q:'GMRCI D
. S PERS=$$GET1^DIQ(200,GMRCI,.01)
. S ^TMP("GMRCNOTF",$J,"B",PERS)=GMRCADUZ(GMRCI)
S PERS="" F S PERS=$O(^TMP("GMRCNOTF",$J,"B",PERS)) Q:PERS="" D
. I $L($P(^TMP("GMRCNOTF",$J,"B",PERS),"~",2)) D Q
.. N LOOP,SERV S LOOP=2
.. N SPACES S SPACES=$$REPEAT^XLFSTR(" ",(34-$L(PERS)))
.. S ^TMP("GMRCNOTF",$J,LINE,0)=PERS_SPACES_$P(^TMP("GMRCNOTF",$J,"B",PERS),"~")
.. S LINE=LINE+1
.. F S SERV=$P(^TMP("GMRCNOTF",$J,"B",PERS),"~",LOOP) Q:SERV="" D
... S ^TMP("GMRCNOTF",$J,LINE,0)=$$REPEAT^XLFSTR(" ",34)_SERV
... S LOOP=LOOP+1,LINE=LINE+1
. N SPACES S SPACES=$$REPEAT^XLFSTR(" ",(34-$L(PERS)))
. S ^TMP("GMRCNOTF",$J,LINE,0)=PERS_SPACES_^TMP("GMRCNOTF",$J,"B",PERS)
. S LINE=LINE+1
K ^TMP("GMRCNOTF",$J,"B")
S VALMCNT=$O(^TMP("GMRCNOTF",$J,999999),-1)
S VALMBG=1
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
Q
;
EXPND ; -- expand code
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCNOTF 1754 printed Apr 09, 2024@20:52:11 Page 2
GMRCNOTF ;SLC/JFR - NOTIFICATION RECIPIENT UTILITIES; 7/31/99 21:58
+1 ;;3.0;CONSULT/REQUEST TRACKING;**11**;DEC 27, 1997
EN ; -- main entry point for GMRC NOTIFICATION RECIPS
+1 NEW GMRCSV
+2 DO SELSS
if '$DATA(GMRCSV)
QUIT
+3 DO INIT
+4 DO EN^VALM("GMRC NOTIFICATION RECIPS")
+5 QUIT
+6 ;
SELSS ; select new service
+1 NEW DIR,X,Y,DIRUT,DUOUT,DTOUT
+2 DO FULL^VALM1
+3 SET DIR(0)="PO^123.5:EMQ"
SET DIR("A")="Select Service"
+4 DO ^DIR
+5 IF $DATA(DIRUT)
QUIT
+6 SET GMRCSV=+Y
+7 KILL ^TMP("GMRCNOTF",$JOB)
+8 QUIT
+9 ;
HDR ; -- header code
+1 SET VALMHDR(1)="Notification Recipients for: "
+2 SET VALMHDR(1)=VALMHDR(1)_$PIECE(^GMR(123.5,+GMRCSV,0),U)
+3 QUIT
+4 ;
INIT ; -- init variables and list array
+1 NEW GMRCADUZ,LINE,GMRCI,PERS
+2 DO EN^GMRCT(+GMRCSV,,1)
+3 IF '$DATA(GMRCADUZ)
SET ^TMP("GMRCNOTF",$JOB,1,0)="No notification recipients"
+4 SET GMRCI=0
SET LINE=1
+5 FOR
SET GMRCI=$ORDER(GMRCADUZ(GMRCI))
if 'GMRCI
QUIT
Begin DoDot:1
+6 SET PERS=$$GET1^DIQ(200,GMRCI,.01)
+7 SET ^TMP("GMRCNOTF",$JOB,"B",PERS)=GMRCADUZ(GMRCI)
End DoDot:1
+8 SET PERS=""
FOR
SET PERS=$ORDER(^TMP("GMRCNOTF",$JOB,"B",PERS))
if PERS=""
QUIT
Begin DoDot:1
+9 IF $LENGTH($PIECE(^TMP("GMRCNOTF",$JOB,"B",PERS),"~",2))
Begin DoDot:2
+10 NEW LOOP,SERV
SET LOOP=2
+11 NEW SPACES
SET SPACES=$$REPEAT^XLFSTR(" ",(34-$LENGTH(PERS)))
+12 SET ^TMP("GMRCNOTF",$JOB,LINE,0)=PERS_SPACES_$PIECE(^TMP("GMRCNOTF",$JOB,"B",PERS),"~")
+13 SET LINE=LINE+1
+14 FOR
SET SERV=$PIECE(^TMP("GMRCNOTF",$JOB,"B",PERS),"~",LOOP)
if SERV=""
QUIT
Begin DoDot:3
+15 SET ^TMP("GMRCNOTF",$JOB,LINE,0)=$$REPEAT^XLFSTR(" ",34)_SERV
+16 SET LOOP=LOOP+1
SET LINE=LINE+1
End DoDot:3
End DoDot:2
QUIT
+17 NEW SPACES
SET SPACES=$$REPEAT^XLFSTR(" ",(34-$LENGTH(PERS)))
+18 SET ^TMP("GMRCNOTF",$JOB,LINE,0)=PERS_SPACES_^TMP("GMRCNOTF",$JOB,"B",PERS)
+19 SET LINE=LINE+1
End DoDot:1
+20 KILL ^TMP("GMRCNOTF",$JOB,"B")
+21 SET VALMCNT=$ORDER(^TMP("GMRCNOTF",$JOB,999999),-1)
+22 SET VALMBG=1
+23 QUIT
+24 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 QUIT
+2 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
