- 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 Jan 18, 2025@02:48:47 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