GMRCT ; SLC/DLT\JFR - Get DUZ's of users for notification to service ; 11/25/2000
;;3.0;CONSULT/REQUEST TRACKING;**1,5,11,18,46**;Dec 27, 1997;Build 23
EN(GMRCSRV,USER,TEST) ;Get who is to be notified for alert action
; return them in array GMRCADUZ(DUZ)=""
N GMRCLIS,GMRCHKD,GMRCNT,GMRCLP,GMRCQUIT
D RECIP(GMRCSRV,$G(TEST)) I $D(TEST),$G(USER),$D(GMRCADUZ(USER)) Q
I '$P(^GMR(123.5,+GMRCSRV,0),U,8) Q ; don't check parents
S GMRCHKD(GMRCSRV)="",GMRCNT=1
D FINDPAR^GMRCAU(GMRCSRV,.GMRCNT) I '$D(GMRCLIS) Q
S GMRCLP=0
F S GMRCLP=$O(GMRCLIS(GMRCLP)) Q:'GMRCLP D I $D(GMRCQUIT) Q
. I +$P(GMRCLIS(GMRCLP),U,2) K GMRCLIS(GMRCLP) Q ;been checked
. I '$D(GMRCHKD(+GMRCLIS(GMRCLP))) D
.. ; check parent
.. D RECIP(+GMRCLIS(GMRCLP),$G(TEST)) I $G(USER),$D(GMRCADUZ(USER)) D Q
... S GMRCQUIT=1
.. S GMRCHKD(+GMRCLIS(GMRCLP))=""
. S $P(GMRCLIS(GMRCLP),U,2)=1
. I $P(^GMR(123.5,+GMRCLIS(GMRCLP),0),U,8) D ;check parents, fld .08 =1
.. D FINDPAR^GMRCAU(+GMRCLIS(GMRCLP),.GMRCNT)
. S GMRCLP=0 ;start back at top and don't miss any
Q
RECIP(GMRCSS,NOTNULL) ;gather recipients for GMRCSS
N GMRCTM,GMRCTMI,GMRCLST,GMRCER,GMRCHL,GMRCSSI,GMRCU,GMRCWL
;I $D(^GMR(123.5,GMRCSS,123)),$P(^GMR(123.5,GMRCSS,123),"^",8),(('$G(NOTNULL))&($P(^GMR(123.5,GMRCSS,123),"^",8)'=DUZ)!($G(NOTNULL))) S GMRCADUZ($P(^(123),"^",8))=$S($G(NOTNULL):$$NOTSERV($P(^(123),"^",8)),1:"")
I $D(^GMR(123.5,GMRCSS,123)),$P(^GMR(123.5,GMRCSS,123),"^",8),($P(^GMR(123.5,GMRCSS,123),"^",8)'=DUZ)!$G(NOTNULL) S GMRCADUZ($P(^(123),"^",8))=$S($G(NOTNULL):$$NOTSERV($P(^(123),"^",8)),1:"")
I $D(^GMR(123.5,GMRCSS,123.1)) D TEAM
I $D(^GMR(123.5,GMRCSS,123.2)),+$G(GMRCO) D LOC
I $D(^GMR(123.5,GMRCSS,123.33)) D ADMU
I $D(^GMR(123.5,GMRCSS,123.34)) D ADMT
Q
LOC ;Find the patients location and match to location assignments
S GMRCWL="",GMRCHL=""
I +$G(GMRCO) S GMRCHL=$P(^GMR(123,+GMRCO,0),"^",4) I GMRCHL S GMRCWL=$G(^SC(GMRCHL,42)) S:GMRCWL GMRCWL=GMRCWL_";DIC(42," S GMRCHL=GMRCHL_";SC("
E S:+$G(GMRCWLI) GMRCWL=GMRCWLI_";DIC(42," S:+$G(GMRCHLI) GMRCHL=GMRCHLI_";SC("
I +GMRCWL S GMRCSSI=$O(^GMR(123.5,GMRCSS,123.2,"B",GMRCWL,"")) I GMRCSSI D LOC1
I +GMRCHL S GMRCSSI=$O(^GMR(123.5,GMRCSS,123.2,"B",GMRCHL,"")) I GMRCSSI D LOC1
Q
LOC1 ;Get user and/or team assigned to location
N GMRCUSER
S GMRCUSER=$P($G(^GMR(123.5,GMRCSS,123.2,GMRCSSI,0)),"^",2)
;I GMRCUSER,(('$G(NOTNULL))&(GMRCUSER'=DUZ)!($G(NOTNULL))) S GMRCADUZ(GMRCUSER)=$S($G(NOTNULL):$$NOTSERV(GMRCUSER),1:"") ;If not user taking action, then add to notification list
I GMRCUSER,(GMRCUSER'=DUZ)!($G(NOTNULL)) S GMRCADUZ(GMRCUSER)=$S($G(NOTNULL):$$NOTSERV(GMRCUSER),1:"") ;If not user taking action, then add to notification list
I $P(^GMR(123.5,GMRCSS,123.2,GMRCSSI,0),"^",3) S GMRCTMI=$P(^(0),"^",3) D TEAM1
Q
ADMU ;Get notification recips from admin users field (123.33)
;Loop "AC" x-ref to get those admin users marked as notif recipients
N RECIP
S RECIP=0
F S RECIP=$O(^GMR(123.5,GMRCSS,123.33,"AC",1,RECIP)) Q:'RECIP D
. I '$G(NOTNULL),RECIP=DUZ Q ;Don't notify user taking action
. S GMRCADUZ(RECIP)=$S($G(NOTNULL):$$NOTSERV(RECIP),1:"")
Q
ADMT ;Get notification recips from admin teams field (123.34)
;Loop "AC" x-ref to get those admin teams marked as notif recipients
;call TEAM1 to get list of users and add to recip list
N GMRCTMI S GMRCTMI=0
F S GMRCTMI=$O(^GMR(123.5,GMRCSS,123.34,"AC",1,GMRCTMI)) Q:'GMRCTMI D
. D TEAM1
TEAM ;Loop through Teams to send all users notifications
S GMRCTM=0 F S GMRCTM=$O(^GMR(123.5,GMRCSS,123.1,GMRCTM)) Q:'+GMRCTM S GMRCTMI=$P($G(^GMR(123.5,GMRCSS,123.1,GMRCTM,0)),"^") I GMRCTMI D TEAM1
Q
TEAM1 ;Get user DUZ's from Team pointed to in File
S GMRCLST="" D TEAMPROV^ORQPTQ1(.GMRCLST,GMRCTMI)
Q:$S('$O(GMRCLST(0)):1,$P(GMRCLST(1),"^",2)="No providers found.":1,1:0)
S GMRCU=0 F S GMRCU=$O(GMRCLST(GMRCU)) Q:GMRCU="" D
. I $P($G(GMRCLST(GMRCU)),"^",1)=DUZ Q ;Don't notify user taking action
. I '$G(NOTNULL),$P($G(GMRCLST(GMRCU)),"^",1)'=DUZ D Q
.. S GMRCADUZ($P(GMRCLST(GMRCU),"^",1)_U_GMRCTMI)=""
. S GMRCADUZ($P(GMRCLST(GMRCU),"^",1))=$S($G(NOTNULL):$$NOTSERV(GMRCU),1:"")
K GMRCLST
Q
NOTSERV(RECIP) ;set GMRCADUZ(RECIP)=all services they receive for
I '$D(GMRCADUZ(RECIP)) Q $P(^GMR(123.5,+GMRCSS,0),U)
Q GMRCADUZ(RECIP)_"~"_$P(^GMR(123.5,+GMRCSS,0),U)
TEST ; called from GMRC NOTIF RECIPIENTS
N GMRCSRV,GMRCUSR,GMRCADUZ
N DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
S DIR(0)="PO^123.5:EM",DIR("A")="Select Consult Service"
S DIR("?")="Choose the consult service to check update status of user"
S DIR("??")="^D TESTHELP^GMRCAU(""ALL SERVICES"")" D ^DIR
I $D(DIRUT) Q
S GMRCSRV=+Y
N DIR
S DIR(0)="PO^200:EM",DIR("A")="Choose notification recipient"
D ^DIR I $D(DIRUT) Q
S GMRCUSR=+Y
D EN(GMRCSRV,GMRCUSR,1)
I $D(GMRCADUZ(GMRCUSR)) D
. W !!,"This user is a notification recipients for "_GMRCADUZ(GMRCUSR),!
. I GMRCADUZ(GMRCUSR)'=$P(^GMR(123.5,GMRCSRV,0),U) D
.. D HIER(GMRCADUZ(GMRCUSR))
. W !!
I '$D(GMRCADUZ(GMRCUSR)) W !!,"This user is not a notification recipient.",!!
G TEST
HIER(SERV) ;ask to see the hierarchy
N DIR,DIRUT,DUOUT,DTOUT
S DIR(0)="Y"
S DIR("A")="View hierarchy from this service to the selected service"
S DIR("B")="NO"
D ^DIR
I Y>0 D TESTHELP^GMRCAU(SERV)
Q
TSTINTRO ; entry action for GMRC USER NOTIFICATION
W !,"This option will list how a given user became a notification recipient"
W !,"for a selected consult service. If the PROCESS PARENTS FOR NOTIFS field is"
W !,"set to YES, all the parents of the service will also be processed to"
W !,"determine if the user is a recipient via that service.",!!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCT 5695 printed Dec 13, 2024@01:47:33 Page 2
GMRCT ; SLC/DLT\JFR - Get DUZ's of users for notification to service ; 11/25/2000
+1 ;;3.0;CONSULT/REQUEST TRACKING;**1,5,11,18,46**;Dec 27, 1997;Build 23
EN(GMRCSRV,USER,TEST) ;Get who is to be notified for alert action
+1 ; return them in array GMRCADUZ(DUZ)=""
+2 NEW GMRCLIS,GMRCHKD,GMRCNT,GMRCLP,GMRCQUIT
+3 DO RECIP(GMRCSRV,$GET(TEST))
IF $DATA(TEST)
IF $GET(USER)
IF $DATA(GMRCADUZ(USER))
QUIT
+4 ; don't check parents
IF '$PIECE(^GMR(123.5,+GMRCSRV,0),U,8)
QUIT
+5 SET GMRCHKD(GMRCSRV)=""
SET GMRCNT=1
+6 DO FINDPAR^GMRCAU(GMRCSRV,.GMRCNT)
IF '$DATA(GMRCLIS)
QUIT
+7 SET GMRCLP=0
+8 FOR
SET GMRCLP=$ORDER(GMRCLIS(GMRCLP))
if 'GMRCLP
QUIT
Begin DoDot:1
+9 ;been checked
IF +$PIECE(GMRCLIS(GMRCLP),U,2)
KILL GMRCLIS(GMRCLP)
QUIT
+10 IF '$DATA(GMRCHKD(+GMRCLIS(GMRCLP)))
Begin DoDot:2
+11 ; check parent
+12 DO RECIP(+GMRCLIS(GMRCLP),$GET(TEST))
IF $GET(USER)
IF $DATA(GMRCADUZ(USER))
Begin DoDot:3
+13 SET GMRCQUIT=1
End DoDot:3
QUIT
+14 SET GMRCHKD(+GMRCLIS(GMRCLP))=""
End DoDot:2
+15 SET $PIECE(GMRCLIS(GMRCLP),U,2)=1
+16 ;check parents, fld .08 =1
IF $PIECE(^GMR(123.5,+GMRCLIS(GMRCLP),0),U,8)
Begin DoDot:2
+17 DO FINDPAR^GMRCAU(+GMRCLIS(GMRCLP),.GMRCNT)
End DoDot:2
+18 ;start back at top and don't miss any
SET GMRCLP=0
End DoDot:1
IF $DATA(GMRCQUIT)
QUIT
+19 QUIT
RECIP(GMRCSS,NOTNULL) ;gather recipients for GMRCSS
+1 NEW GMRCTM,GMRCTMI,GMRCLST,GMRCER,GMRCHL,GMRCSSI,GMRCU,GMRCWL
+2 ;I $D(^GMR(123.5,GMRCSS,123)),$P(^GMR(123.5,GMRCSS,123),"^",8),(('$G(NOTNULL))&($P(^GMR(123.5,GMRCSS,123),"^",8)'=DUZ)!($G(NOTNULL))) S GMRCADUZ($P(^(123),"^",8))=$S($G(NOTNULL):$$NOTSERV($P(^(123),"^",8)),1:"")
+3 IF $DATA(^GMR(123.5,GMRCSS,123))
IF $PIECE(^GMR(123.5,GMRCSS,123),"^",8)
IF ($PIECE(^GMR(123.5,GMRCSS,123),"^",8)'=DUZ)!$GET(NOTNULL)
SET GMRCADUZ($PIECE(^(123),"^",8))=$SELECT($GET(NOTNULL):$$NOTSERV($PIECE(^(123),"^",8)),1:"")
+4 IF $DATA(^GMR(123.5,GMRCSS,123.1))
DO TEAM
+5 IF $DATA(^GMR(123.5,GMRCSS,123.2))
IF +$GET(GMRCO)
DO LOC
+6 IF $DATA(^GMR(123.5,GMRCSS,123.33))
DO ADMU
+7 IF $DATA(^GMR(123.5,GMRCSS,123.34))
DO ADMT
+8 QUIT
LOC ;Find the patients location and match to location assignments
+1 SET GMRCWL=""
SET GMRCHL=""
+2 IF +$GET(GMRCO)
SET GMRCHL=$PIECE(^GMR(123,+GMRCO,0),"^",4)
IF GMRCHL
SET GMRCWL=$GET(^SC(GMRCHL,42))
if GMRCWL
SET GMRCWL=GMRCWL_";DIC(42,"
SET GMRCHL=GMRCHL_";SC("
+3 IF '$TEST
if +$GET(GMRCWLI)
SET GMRCWL=GMRCWLI_";DIC(42,"
if +$GET(GMRCHLI)
SET GMRCHL=GMRCHLI_";SC("
+4 IF +GMRCWL
SET GMRCSSI=$ORDER(^GMR(123.5,GMRCSS,123.2,"B",GMRCWL,""))
IF GMRCSSI
DO LOC1
+5 IF +GMRCHL
SET GMRCSSI=$ORDER(^GMR(123.5,GMRCSS,123.2,"B",GMRCHL,""))
IF GMRCSSI
DO LOC1
+6 QUIT
LOC1 ;Get user and/or team assigned to location
+1 NEW GMRCUSER
+2 SET GMRCUSER=$PIECE($GET(^GMR(123.5,GMRCSS,123.2,GMRCSSI,0)),"^",2)
+3 ;I GMRCUSER,(('$G(NOTNULL))&(GMRCUSER'=DUZ)!($G(NOTNULL))) S GMRCADUZ(GMRCUSER)=$S($G(NOTNULL):$$NOTSERV(GMRCUSER),1:"") ;If not user taking action, then add to notification list
+4 ;If not user taking action, then add to notification list
IF GMRCUSER
IF (GMRCUSER'=DUZ)!($GET(NOTNULL))
SET GMRCADUZ(GMRCUSER)=$SELECT($GET(NOTNULL):$$NOTSERV(GMRCUSER),1:"")
+5 IF $PIECE(^GMR(123.5,GMRCSS,123.2,GMRCSSI,0),"^",3)
SET GMRCTMI=$PIECE(^(0),"^",3)
DO TEAM1
+6 QUIT
ADMU ;Get notification recips from admin users field (123.33)
+1 ;Loop "AC" x-ref to get those admin users marked as notif recipients
+2 NEW RECIP
+3 SET RECIP=0
+4 FOR
SET RECIP=$ORDER(^GMR(123.5,GMRCSS,123.33,"AC",1,RECIP))
if 'RECIP
QUIT
Begin DoDot:1
+5 ;Don't notify user taking action
IF '$GET(NOTNULL)
IF RECIP=DUZ
QUIT
+6 SET GMRCADUZ(RECIP)=$SELECT($GET(NOTNULL):$$NOTSERV(RECIP),1:"")
End DoDot:1
+7 QUIT
ADMT ;Get notification recips from admin teams field (123.34)
+1 ;Loop "AC" x-ref to get those admin teams marked as notif recipients
+2 ;call TEAM1 to get list of users and add to recip list
+3 NEW GMRCTMI
SET GMRCTMI=0
+4 FOR
SET GMRCTMI=$ORDER(^GMR(123.5,GMRCSS,123.34,"AC",1,GMRCTMI))
if 'GMRCTMI
QUIT
Begin DoDot:1
+5 DO TEAM1
End DoDot:1
TEAM ;Loop through Teams to send all users notifications
+1 SET GMRCTM=0
FOR
SET GMRCTM=$ORDER(^GMR(123.5,GMRCSS,123.1,GMRCTM))
if '+GMRCTM
QUIT
SET GMRCTMI=$PIECE($GET(^GMR(123.5,GMRCSS,123.1,GMRCTM,0)),"^")
IF GMRCTMI
DO TEAM1
+2 QUIT
TEAM1 ;Get user DUZ's from Team pointed to in File
+1 SET GMRCLST=""
DO TEAMPROV^ORQPTQ1(.GMRCLST,GMRCTMI)
+2 if $SELECT('$ORDER(GMRCLST(0))
QUIT
+3 SET GMRCU=0
FOR
SET GMRCU=$ORDER(GMRCLST(GMRCU))
if GMRCU=""
QUIT
Begin DoDot:1
+4 ;Don't notify user taking action
IF $PIECE($GET(GMRCLST(GMRCU)),"^",1)=DUZ
QUIT
+5 IF '$GET(NOTNULL)
IF $PIECE($GET(GMRCLST(GMRCU)),"^",1)'=DUZ
Begin DoDot:2
+6 SET GMRCADUZ($PIECE(GMRCLST(GMRCU),"^",1)_U_GMRCTMI)=""
End DoDot:2
QUIT
+7 SET GMRCADUZ($PIECE(GMRCLST(GMRCU),"^",1))=$SELECT($GET(NOTNULL):$$NOTSERV(GMRCU),1:"")
End DoDot:1
+8 KILL GMRCLST
+9 QUIT
NOTSERV(RECIP) ;set GMRCADUZ(RECIP)=all services they receive for
+1 IF '$DATA(GMRCADUZ(RECIP))
QUIT $PIECE(^GMR(123.5,+GMRCSS,0),U)
+2 QUIT GMRCADUZ(RECIP)_"~"_$PIECE(^GMR(123.5,+GMRCSS,0),U)
TEST ; called from GMRC NOTIF RECIPIENTS
+1 NEW GMRCSRV,GMRCUSR,GMRCADUZ
+2 NEW DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
+3 SET DIR(0)="PO^123.5:EM"
SET DIR("A")="Select Consult Service"
+4 SET DIR("?")="Choose the consult service to check update status of user"
+5 SET DIR("??")="^D TESTHELP^GMRCAU(""ALL SERVICES"")"
DO ^DIR
+6 IF $DATA(DIRUT)
QUIT
+7 SET GMRCSRV=+Y
+8 NEW DIR
+9 SET DIR(0)="PO^200:EM"
SET DIR("A")="Choose notification recipient"
+10 DO ^DIR
IF $DATA(DIRUT)
QUIT
+11 SET GMRCUSR=+Y
+12 DO EN(GMRCSRV,GMRCUSR,1)
+13 IF $DATA(GMRCADUZ(GMRCUSR))
Begin DoDot:1
+14 WRITE !!,"This user is a notification recipients for "_GMRCADUZ(GMRCUSR),!
+15 IF GMRCADUZ(GMRCUSR)'=$PIECE(^GMR(123.5,GMRCSRV,0),U)
Begin DoDot:2
+16 DO HIER(GMRCADUZ(GMRCUSR))
End DoDot:2
+17 WRITE !!
End DoDot:1
+18 IF '$DATA(GMRCADUZ(GMRCUSR))
WRITE !!,"This user is not a notification recipient.",!!
+19 GOTO TEST
HIER(SERV) ;ask to see the hierarchy
+1 NEW DIR,DIRUT,DUOUT,DTOUT
+2 SET DIR(0)="Y"
+3 SET DIR("A")="View hierarchy from this service to the selected service"
+4 SET DIR("B")="NO"
+5 DO ^DIR
+6 IF Y>0
DO TESTHELP^GMRCAU(SERV)
+7 QUIT
TSTINTRO ; entry action for GMRC USER NOTIFICATION
+1 WRITE !,"This option will list how a given user became a notification recipient"
+2 WRITE !,"for a selected consult service. If the PROCESS PARENTS FOR NOTIFS field is"
+3 WRITE !,"set to YES, all the parents of the service will also be processed to"
+4 WRITE !,"determine if the user is a recipient via that service.",!!
+5 QUIT
