VAQREQ07 ;ALB/JFP - PDX, CREATE NOTIFY LIST, REQUEST SCREEN;01MAR93
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
EP ; -- Main entry point for the list processor
; - Called from VAQREQ02
;
REQ ; -- Request users for notify list
K ^TMP("VAQNOTI",$J)
N POP,NOTIDA,NOTIUSER,DIRUT,DTOUT,DUOUT,D,J,L,N,X,Y
;
F J=1:1 D ASKNOTI I $D(DIRUT) D DBLCHK Q:$D(DIRUT)!(POP)
; -- Cleanup and quit
K POP,NOTIDA,NOTIUSER,DIRUT,DTOUT,DUOUT,D,J,L,N,X,Y
K MAILDA,MAILNM
QUIT
;
DBLCHK ; -- Double check for exit
Q:$D(DUOUT)
S (VAQNOTI,POP)="0"
I $D(^TMP("VAQNOTI",$J)) D DBL1
QUIT
;
DBL1 ;
W !!
S DIR(0)="Y",DIR("B")="NO",DIR("A")="Include Data with Notification(s):"
D ^DIR K DIR
I Y=1 S VAQNOTI="1"
W !!
S DIR(0)="Y",DIR("B")="YES",DIR("A")="Exit Notify:"
D ^DIR K DIR
I Y=1 S POP=1
QUIT
;
ASKNOTI ; -- Call to Dir to request notify list
D:$D(^TMP("VAQNOTI",$J)) LISTD
S POP=0
S DIR("A")="User to notify: "
S DIR(0)="FAO^1:30"
S DIR("?")="^D HLP1^VAQREQ07"
S DIR("??")="^D HLP2^VAQREQ07"
W ! D ^DIR K DIR Q:$D(DIRUT)
S X=Y
I X="*L" D LISTD Q:POP
I $E(X,1,1)="-" D DELNOTI Q:POP
I $E(X,1,2)'="G." D NOTI Q:POP
I $E(X,1,2)="G." D GNOTI Q:POP
QUIT
;
NOTI ; -- Dic lookup to verify user in file 200 (new person)
S DIC="^VA(200,",DIC(0)="EMQZ"
D ^DIC K DIC I $D(DTOUT)!$D(DUOUT)!(Y<0) S POP=1 QUIT
S NOTIDA=$P(Y,U,1),NOTIUSER=$P(Y,U,2),^TMP("VAQNOTI",$J,NOTIUSER)=NOTIDA
QUIT
;
GNOTI ; -- Dic lookup to verify mail group name in file XMB(3.8
S X=$P(X,".",2) ; -- strip off G.
S DIC="^XMB(3.8,"
S DIC(0)="EMQZ"
D ^DIC K DIC I $D(DTOUT)!$D(DUOUT)!(Y<0) S POP=1 QUIT
S MAILDA=$P(Y,U,1)
S MAILNM=$P(Y,U,2)
D G1
QUIT
;
G1 S NOTIDA=""
N XMDUZ,XMCHAN,X,Y
S XMDUZ=$G(DUZ),XMCHAN=1
S X="G."_MAILNM
D WHO^XMA21 ; -- Mailman call to determine whos in group, sets XMY(
F S NOTIDA=$O(XMY(NOTIDA)) Q:'NOTIDA D SETG
QUIT
;
SETG ; --
Q:NOTIDA'?1N.N
S NOTIUSER=$P($G(^VA(200,NOTIDA,0)),U,1)
S ^TMP("VAQNOTI",$J,NOTIUSER)=NOTIDA
QUIT
;
DELNOTI ; -- Deletes person from notify list
S POP=1,X=$E(X,2,99)
I X="" W " ...No Entries Selected" QUIT
S X=$$PARTIC^VAQUTL94("^TMP(""VAQNOTI"","_$J_")",X)
I X=-1 W " ... Not Selected" QUIT
I '$D(^TMP("VAQNOTI",$J,X)) W " ... ",X," Not Selected" QUIT
K ^TMP("VAQNOTI",$J,X) W " ... ",X," Deleted"
QUIT
;
HLP1 ; -- Display options for user to notify prompt
W !!!,"Options for User to notify prompt:",!
W !,"User to notify: users name ; select user (new person)"
W !,"User to notify: G.mail group ; select mail group"
W !,"User to notify: -users name ; de-selects a user"
W !,"User to notify: *L ; list selected users"
W !,"User to notify: ^ ; terminates option"
W !,"User to notify: return ; done with option"
W !,"User to notify: ? ; list of input options"
W !,"User to notify: ?? ; displays choices"
QUIT
;
HLP2 ; -- Display new person file or mail group file
W !!,"(1) - New Person",!,"(2) - Mail Group",!
R "Select Display Option: ",X:DTIME Q:X=""
I X="^" QUIT
I X=1 D H1 QUIT
I X=2 D H2 QUIT
W " ...invalid entry"
K X
QUIT
;
H1 ; -- Displays new person file
S DIC="^VA(200,",DIC(0)="C",D="B"
D DQ^DICQ
K DIC,D
QUIT
;
H2 ; -- Display mail groups
S DIC="^XMB(3.8,"
S DIC(0)="CM"
S D="B",DZ="??"
D DQ^DICQ
K DIC,D,DZ
QUIT
;
LISTD ; -- Displays a list of names selected
S POP=1
I '$D(^TMP("VAQNOTI",$J)) W " ...No User(s) Selected" QUIT
W !!,"-------------------------------- User Selected --------------------------------"
S N="" F L=0:1 S N=$O(^TMP("VAQNOTI",$J,N)) Q:N="" W:'(L#8) ! W ?L#8*30 W N
W !,"--------------------------------------------------------------------------------"
W ! QUIT
;
END ; -- End of code
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQREQ07 3908 printed Sep 23, 2025@20:02:26 Page 2
VAQREQ07 ;ALB/JFP - PDX, CREATE NOTIFY LIST, REQUEST SCREEN;01MAR93
+1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
EP ; -- Main entry point for the list processor
+1 ; - Called from VAQREQ02
+2 ;
REQ ; -- Request users for notify list
+1 KILL ^TMP("VAQNOTI",$JOB)
+2 NEW POP,NOTIDA,NOTIUSER,DIRUT,DTOUT,DUOUT,D,J,L,N,X,Y
+3 ;
+4 FOR J=1:1
DO ASKNOTI
IF $DATA(DIRUT)
DO DBLCHK
if $DATA(DIRUT)!(POP)
QUIT
+5 ; -- Cleanup and quit
+6 KILL POP,NOTIDA,NOTIUSER,DIRUT,DTOUT,DUOUT,D,J,L,N,X,Y
+7 KILL MAILDA,MAILNM
+8 QUIT
+9 ;
DBLCHK ; -- Double check for exit
+1 if $DATA(DUOUT)
QUIT
+2 SET (VAQNOTI,POP)="0"
+3 IF $DATA(^TMP("VAQNOTI",$JOB))
DO DBL1
+4 QUIT
+5 ;
DBL1 ;
+1 WRITE !!
+2 SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A")="Include Data with Notification(s):"
+3 DO ^DIR
KILL DIR
+4 IF Y=1
SET VAQNOTI="1"
+5 WRITE !!
+6 SET DIR(0)="Y"
SET DIR("B")="YES"
SET DIR("A")="Exit Notify:"
+7 DO ^DIR
KILL DIR
+8 IF Y=1
SET POP=1
+9 QUIT
+10 ;
ASKNOTI ; -- Call to Dir to request notify list
+1 if $DATA(^TMP("VAQNOTI",$JOB))
DO LISTD
+2 SET POP=0
+3 SET DIR("A")="User to notify: "
+4 SET DIR(0)="FAO^1:30"
+5 SET DIR("?")="^D HLP1^VAQREQ07"
+6 SET DIR("??")="^D HLP2^VAQREQ07"
+7 WRITE !
DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+8 SET X=Y
+9 IF X="*L"
DO LISTD
if POP
QUIT
+10 IF $EXTRACT(X,1,1)="-"
DO DELNOTI
if POP
QUIT
+11 IF $EXTRACT(X,1,2)'="G."
DO NOTI
if POP
QUIT
+12 IF $EXTRACT(X,1,2)="G."
DO GNOTI
if POP
QUIT
+13 QUIT
+14 ;
NOTI ; -- Dic lookup to verify user in file 200 (new person)
+1 SET DIC="^VA(200,"
SET DIC(0)="EMQZ"
+2 DO ^DIC
KILL DIC
IF $DATA(DTOUT)!$DATA(DUOUT)!(Y<0)
SET POP=1
QUIT
+3 SET NOTIDA=$PIECE(Y,U,1)
SET NOTIUSER=$PIECE(Y,U,2)
SET ^TMP("VAQNOTI",$JOB,NOTIUSER)=NOTIDA
+4 QUIT
+5 ;
GNOTI ; -- Dic lookup to verify mail group name in file XMB(3.8
+1 ; -- strip off G.
SET X=$PIECE(X,".",2)
+2 SET DIC="^XMB(3.8,"
+3 SET DIC(0)="EMQZ"
+4 DO ^DIC
KILL DIC
IF $DATA(DTOUT)!$DATA(DUOUT)!(Y<0)
SET POP=1
QUIT
+5 SET MAILDA=$PIECE(Y,U,1)
+6 SET MAILNM=$PIECE(Y,U,2)
+7 DO G1
+8 QUIT
+9 ;
G1 SET NOTIDA=""
+1 NEW XMDUZ,XMCHAN,X,Y
+2 SET XMDUZ=$GET(DUZ)
SET XMCHAN=1
+3 SET X="G."_MAILNM
+4 ; -- Mailman call to determine whos in group, sets XMY(
DO WHO^XMA21
+5 FOR
SET NOTIDA=$ORDER(XMY(NOTIDA))
if 'NOTIDA
QUIT
DO SETG
+6 QUIT
+7 ;
SETG ; --
+1 if NOTIDA'?1N.N
QUIT
+2 SET NOTIUSER=$PIECE($GET(^VA(200,NOTIDA,0)),U,1)
+3 SET ^TMP("VAQNOTI",$JOB,NOTIUSER)=NOTIDA
+4 QUIT
+5 ;
DELNOTI ; -- Deletes person from notify list
+1 SET POP=1
SET X=$EXTRACT(X,2,99)
+2 IF X=""
WRITE " ...No Entries Selected"
QUIT
+3 SET X=$$PARTIC^VAQUTL94("^TMP(""VAQNOTI"","_$JOB_")",X)
+4 IF X=-1
WRITE " ... Not Selected"
QUIT
+5 IF '$DATA(^TMP("VAQNOTI",$JOB,X))
WRITE " ... ",X," Not Selected"
QUIT
+6 KILL ^TMP("VAQNOTI",$JOB,X)
WRITE " ... ",X," Deleted"
+7 QUIT
+8 ;
HLP1 ; -- Display options for user to notify prompt
+1 WRITE !!!,"Options for User to notify prompt:",!
+2 WRITE !,"User to notify: users name ; select user (new person)"
+3 WRITE !,"User to notify: G.mail group ; select mail group"
+4 WRITE !,"User to notify: -users name ; de-selects a user"
+5 WRITE !,"User to notify: *L ; list selected users"
+6 WRITE !,"User to notify: ^ ; terminates option"
+7 WRITE !,"User to notify: return ; done with option"
+8 WRITE !,"User to notify: ? ; list of input options"
+9 WRITE !,"User to notify: ?? ; displays choices"
+10 QUIT
+11 ;
HLP2 ; -- Display new person file or mail group file
+1 WRITE !!,"(1) - New Person",!,"(2) - Mail Group",!
+2 READ "Select Display Option: ",X:DTIME
if X=""
QUIT
+3 IF X="^"
QUIT
+4 IF X=1
DO H1
QUIT
+5 IF X=2
DO H2
QUIT
+6 WRITE " ...invalid entry"
+7 KILL X
+8 QUIT
+9 ;
H1 ; -- Displays new person file
+1 SET DIC="^VA(200,"
SET DIC(0)="C"
SET D="B"
+2 DO DQ^DICQ
+3 KILL DIC,D
+4 QUIT
+5 ;
H2 ; -- Display mail groups
+1 SET DIC="^XMB(3.8,"
+2 SET DIC(0)="CM"
+3 SET D="B"
SET DZ="??"
+4 DO DQ^DICQ
+5 KILL DIC,D,DZ
+6 QUIT
+7 ;
LISTD ; -- Displays a list of names selected
+1 SET POP=1
+2 IF '$DATA(^TMP("VAQNOTI",$JOB))
WRITE " ...No User(s) Selected"
QUIT
+3 WRITE !!,"-------------------------------- User Selected --------------------------------"
+4 SET N=""
FOR L=0:1
SET N=$ORDER(^TMP("VAQNOTI",$JOB,N))
if N=""
QUIT
if '(L#8)
WRITE !
WRITE ?L#8*30
WRITE N
+5 WRITE !,"--------------------------------------------------------------------------------"
+6 WRITE !
QUIT
+7 ;
END ; -- End of code
+1 QUIT
