Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMRCT

GMRCT.m

Go to the documentation of this file.
  1. 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
  1. EN(GMRCSRV,USER,TEST) ;Get who is to be notified for alert action
  1. ; return them in array GMRCADUZ(DUZ)=""
  1. N GMRCLIS,GMRCHKD,GMRCNT,GMRCLP,GMRCQUIT
  1. D RECIP(GMRCSRV,$G(TEST)) I $D(TEST),$G(USER),$D(GMRCADUZ(USER)) Q
  1. I '$P(^GMR(123.5,+GMRCSRV,0),U,8) Q ; don't check parents
  1. S GMRCHKD(GMRCSRV)="",GMRCNT=1
  1. D FINDPAR^GMRCAU(GMRCSRV,.GMRCNT) I '$D(GMRCLIS) Q
  1. S GMRCLP=0
  1. F S GMRCLP=$O(GMRCLIS(GMRCLP)) Q:'GMRCLP D I $D(GMRCQUIT) Q
  1. . I +$P(GMRCLIS(GMRCLP),U,2) K GMRCLIS(GMRCLP) Q ;been checked
  1. . I '$D(GMRCHKD(+GMRCLIS(GMRCLP))) D
  1. .. ; check parent
  1. .. D RECIP(+GMRCLIS(GMRCLP),$G(TEST)) I $G(USER),$D(GMRCADUZ(USER)) D Q
  1. ... S GMRCQUIT=1
  1. .. S GMRCHKD(+GMRCLIS(GMRCLP))=""
  1. . S $P(GMRCLIS(GMRCLP),U,2)=1
  1. . I $P(^GMR(123.5,+GMRCLIS(GMRCLP),0),U,8) D ;check parents, fld .08 =1
  1. .. D FINDPAR^GMRCAU(+GMRCLIS(GMRCLP),.GMRCNT)
  1. . S GMRCLP=0 ;start back at top and don't miss any
  1. Q
  1. RECIP(GMRCSS,NOTNULL) ;gather recipients for GMRCSS
  1. N GMRCTM,GMRCTMI,GMRCLST,GMRCER,GMRCHL,GMRCSSI,GMRCU,GMRCWL
  1. ;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:"")
  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:"")
  1. I $D(^GMR(123.5,GMRCSS,123.1)) D TEAM
  1. I $D(^GMR(123.5,GMRCSS,123.2)),+$G(GMRCO) D LOC
  1. I $D(^GMR(123.5,GMRCSS,123.33)) D ADMU
  1. I $D(^GMR(123.5,GMRCSS,123.34)) D ADMT
  1. Q
  1. LOC ;Find the patients location and match to location assignments
  1. S GMRCWL="",GMRCHL=""
  1. 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("
  1. E S:+$G(GMRCWLI) GMRCWL=GMRCWLI_";DIC(42," S:+$G(GMRCHLI) GMRCHL=GMRCHLI_";SC("
  1. I +GMRCWL S GMRCSSI=$O(^GMR(123.5,GMRCSS,123.2,"B",GMRCWL,"")) I GMRCSSI D LOC1
  1. I +GMRCHL S GMRCSSI=$O(^GMR(123.5,GMRCSS,123.2,"B",GMRCHL,"")) I GMRCSSI D LOC1
  1. Q
  1. LOC1 ;Get user and/or team assigned to location
  1. N GMRCUSER
  1. S GMRCUSER=$P($G(^GMR(123.5,GMRCSS,123.2,GMRCSSI,0)),"^",2)
  1. ;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
  1. 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
  1. I $P(^GMR(123.5,GMRCSS,123.2,GMRCSSI,0),"^",3) S GMRCTMI=$P(^(0),"^",3) D TEAM1
  1. Q
  1. ADMU ;Get notification recips from admin users field (123.33)
  1. ;Loop "AC" x-ref to get those admin users marked as notif recipients
  1. N RECIP
  1. S RECIP=0
  1. F S RECIP=$O(^GMR(123.5,GMRCSS,123.33,"AC",1,RECIP)) Q:'RECIP D
  1. . I '$G(NOTNULL),RECIP=DUZ Q ;Don't notify user taking action
  1. . S GMRCADUZ(RECIP)=$S($G(NOTNULL):$$NOTSERV(RECIP),1:"")
  1. Q
  1. ADMT ;Get notification recips from admin teams field (123.34)
  1. ;Loop "AC" x-ref to get those admin teams marked as notif recipients
  1. ;call TEAM1 to get list of users and add to recip list
  1. N GMRCTMI S GMRCTMI=0
  1. F S GMRCTMI=$O(^GMR(123.5,GMRCSS,123.34,"AC",1,GMRCTMI)) Q:'GMRCTMI D
  1. . D TEAM1
  1. TEAM ;Loop through Teams to send all users notifications
  1. 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
  1. Q
  1. TEAM1 ;Get user DUZ's from Team pointed to in File
  1. S GMRCLST="" D TEAMPROV^ORQPTQ1(.GMRCLST,GMRCTMI)
  1. Q:$S('$O(GMRCLST(0)):1,$P(GMRCLST(1),"^",2)="No providers found.":1,1:0)
  1. S GMRCU=0 F S GMRCU=$O(GMRCLST(GMRCU)) Q:GMRCU="" D
  1. . I $P($G(GMRCLST(GMRCU)),"^",1)=DUZ Q ;Don't notify user taking action
  1. . I '$G(NOTNULL),$P($G(GMRCLST(GMRCU)),"^",1)'=DUZ D Q
  1. .. S GMRCADUZ($P(GMRCLST(GMRCU),"^",1)_U_GMRCTMI)=""
  1. . S GMRCADUZ($P(GMRCLST(GMRCU),"^",1))=$S($G(NOTNULL):$$NOTSERV(GMRCU),1:"")
  1. K GMRCLST
  1. Q
  1. NOTSERV(RECIP) ;set GMRCADUZ(RECIP)=all services they receive for
  1. I '$D(GMRCADUZ(RECIP)) Q $P(^GMR(123.5,+GMRCSS,0),U)
  1. Q GMRCADUZ(RECIP)_"~"_$P(^GMR(123.5,+GMRCSS,0),U)
  1. TEST ; called from GMRC NOTIF RECIPIENTS
  1. N GMRCSRV,GMRCUSR,GMRCADUZ
  1. N DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
  1. S DIR(0)="PO^123.5:EM",DIR("A")="Select Consult Service"
  1. S DIR("?")="Choose the consult service to check update status of user"
  1. S DIR("??")="^D TESTHELP^GMRCAU(""ALL SERVICES"")" D ^DIR
  1. I $D(DIRUT) Q
  1. S GMRCSRV=+Y
  1. N DIR
  1. S DIR(0)="PO^200:EM",DIR("A")="Choose notification recipient"
  1. D ^DIR I $D(DIRUT) Q
  1. S GMRCUSR=+Y
  1. D EN(GMRCSRV,GMRCUSR,1)
  1. I $D(GMRCADUZ(GMRCUSR)) D
  1. . W !!,"This user is a notification recipients for "_GMRCADUZ(GMRCUSR),!
  1. . I GMRCADUZ(GMRCUSR)'=$P(^GMR(123.5,GMRCSRV,0),U) D
  1. .. D HIER(GMRCADUZ(GMRCUSR))
  1. . W !!
  1. I '$D(GMRCADUZ(GMRCUSR)) W !!,"This user is not a notification recipient.",!!
  1. G TEST
  1. HIER(SERV) ;ask to see the hierarchy
  1. N DIR,DIRUT,DUOUT,DTOUT
  1. S DIR(0)="Y"
  1. S DIR("A")="View hierarchy from this service to the selected service"
  1. S DIR("B")="NO"
  1. D ^DIR
  1. I Y>0 D TESTHELP^GMRCAU(SERV)
  1. Q
  1. TSTINTRO ; entry action for GMRC USER NOTIFICATION
  1. W !,"This option will list how a given user became a notification recipient"
  1. W !,"for a selected consult service. If the PROCESS PARENTS FOR NOTIFS field is"
  1. W !,"set to YES, all the parents of the service will also be processed to"
  1. W !,"determine if the user is a recipient via that service.",!!
  1. Q