source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORBPRCHK.m@ 1211

Last change on this file since 1211 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.8 KB
Line 
1ORBPRCHK ; SLC/JMH - API to return who gets notifications TAKEN FROM ORB3;
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242
3CHECK(ORPERS,ORNUM,ORN,ORBDFN) ; returns 1 if ORPERS should get the alert
4 N ORRET,ORY
5 D START(.ORRET,ORNUM,ORN,ORBDFN)
6 S ORY=$S($D(ORRET(ORPERS)):1,1:0)
7 Q ORY
8START(ORRET,ORNUM,ORN,ORBDFN) ;
9 Q:$G(ORN)=""!($G(ORBDFN)="")
10 Q:'$L($G(^ORD(100.9,ORN,0)))
11 N ORBNOW,ORBID,ORBLOCK,ORBDESC
12 S ORBNOW=$$NOW^XLFDT
13 N ORBDUZ,ORBN,ORBXQAID,ORPTNAM,ORBPRIM,ORBATTD,ORBDEV,ORBENT
14 N XQA,VAIN,VADM,DIC,ORBPDATA,ORBPMSG,VA,VA200,VAERR,X,Y
15 N ORBUI,ORBASPEC,ORBSMSG,ORBADT,ORBSDEV,ORBDEL,ORBDI,ORBTDEV,ORY
16 S ORBUI=1,ORBADT=0
17 S:'$L($G(ORBPMSG)) ORBPMSG=""
18 S ORBPDATA=+$G(ORNUM)_"@"
19 S ORBN=^ORD(100.9,ORN,0)
20 ;
21 S ORBENT=$$ENTITY^ORB31(ORNUM)
22 D REGULAR^ORB3REG(ORN,.XQA,.ORBU,.ORBUI,.ORBDEV,ORBDFN)
23 D SPECIAL^ORB3SPEC(ORN,.ORBASPEC,.ORBU,.ORBUI,$G(ORNUM),ORBDFN,$G(ORBPDATA),.ORBSMSG,$G(ORBPMSG),.ORBSDEV,$G(ORBPRIM),$G(ORBATTD))
24 I $D(ORBASPEC)>1 D SPECDUZS ;special recips
25 I $D(ORBADUZ)>1 D PKGDUZS ;pkg-supplied recips
26 D TITLE ;provider recips
27 M ORRET=XQA
28 Q
29PKGDUZS ;get DUZs from pkg-passed ORBADUZ() array
30 N ORBPDUZ
31 S ORBPDUZ=""
32 F S ORBPDUZ=$O(ORBADUZ(ORBPDUZ)) Q:ORBPDUZ="" S ORBDUZ=ORBPDUZ D USER
33 Q
34SPECDUZS ;get DUZs rtn by SPECIAL^ORB3SPEC
35 N ORBSDUZ
36 S ORBSDUZ=""
37 F S ORBSDUZ=$O(ORBASPEC(ORBSDUZ)) Q:ORBSDUZ="" S ORBDUZ=ORBSDUZ D USER
38 Q
39TITLE ;get provider recips
40 N TITLES
41 S TITLES=$$GET^XPAR(ORBENT,"ORB PROVIDER RECIPIENTS",ORN,"I")
42 I TITLES["P" D PRIMARY
43 I TITLES["A" D ATTEND
44 I TITLES["T" D TEAMS
45 I TITLES["O" D ORDERER
46 I TITLES["E" D ENTERBY
47 I TITLES["R" D PCMMPRIM
48 I TITLES["S" D PCMMASSC
49 I TITLES["M" D PCMMTEAM
50 Q
51PRIMARY ;
52 I +$G(ORBPRIM)>0 S ORBDUZ=ORBPRIM D USER
53 Q
54ATTEND ;
55 I +$G(ORBATTD)>0 S ORBDUZ=ORBATTD D USER
56 Q
57TEAMS ;
58 N ORBLST,ORBI,ORBJ,ORBTM,ORBTNAME,ORBTTYPE,ORBTD
59 D TMSPT^ORQPTQ1(.ORBLST,ORBDFN)
60 Q:+$G(ORBLST(1))<1
61 S ORBI="" F S ORBI=$O(ORBLST(ORBI)) Q:ORBI="" D
62 .S ORBTM=$P(ORBLST(ORBI),U),ORBTNAME=$P(ORBLST(ORBI),U,2)
63 .S ORBTTYPE=$P(ORBLST(ORBI),U,3)
64 .I $D(ORBU) D
65 ..S ORBU(ORBUI)=" Patient list "_ORBTNAME_" ["_ORBTTYPE_"]:",ORBUI=ORBUI+1
66 .N ORBLST2 D TEAMPROV^ORQPTQ1(.ORBLST2,ORBTM)
67 .Q:+$G(ORBLST2(1))<1
68 .S ORBJ="" F S ORBJ=$O(ORBLST2(ORBJ)) Q:ORBJ="" D
69 ..S ORBDUZ=$P(ORBLST2(ORBJ),U)_U_ORBTM I +$G(ORBDUZ)>0 D USER
70 .;
71 .S ORBTD=$P($$TMDEV^ORB31(ORBTM),U,2) ;Team's device
72 .I $L(ORBTD) D
73 ..S ORBTDEV(ORBTD)=""
74 ..I $D(ORBU) D
75 ...S ORBU(ORBUI)=" Team's Device "_ORBTD_" is a recipient",ORBUI=ORBUI+1
76 Q
77ORDERER ;
78 Q:+$G(ORNUM)<1
79 I $D(ORBU) S ORBU(ORBUI)=" Ordering provider:",ORBUI=ORBUI+1
80 N ORBLST,ORBI,ORBTM,ORBJ,ORBTNAME,ORBPLST,ORBPI,ORBPTM,ORBTTYPE
81 S ORBDUZ=$S(ORN=12:+$$UNSIGNOR^ORQOR2(ORNUM),1:$$ORDERER^ORQOR2(ORNUM))
82 I +$G(ORBDUZ)>0 D
83 .D USER
84 .;if notif = Order Req E/S (#12) or Order Req Co-sign (#37) and
85 .;user doesn't have ES authority, send to fellow team members w/ES:
86 .I ((ORN=12)!(ORN=37)),('$D(^XUSEC("ORES",ORBDUZ))) D
87 ..I $D(ORBU) S ORBU(ORBUI)=" Orderer can't elec sign, getting teams orderer belongs to:",ORBUI=ORBUI+1
88 ..D TEAMPR^ORQPTQ1(.ORBLST,ORBDUZ) ;get orderer's tms
89 ..Q:+$G(ORBLST(1))<1
90 ..D TMSPT^ORQPTQ1(.ORBPLST,ORBDFN) ;get pt's tms
91 ..Q:+$G(ORBPLST(1))<1
92 ..S ORBI="" F S ORBI=$O(ORBLST(ORBI)) Q:ORBI="" D
93 ...S ORBPI="" F S ORBPI=$O(ORBPLST(ORBPI)) Q:ORBPI="" D
94 ....S ORBTM=$P(ORBLST(ORBI),U),ORBPTM=$P(ORBPLST(ORBPI),U)
95 ....I ORBTM=ORBPTM D ;if pt is on provider's team
96 .....I +$G(ORBPTM)>0 D
97 ......S ORBTNAME=$P(ORBPLST(ORBPI),U,2)
98 ......S ORBTTYPE=$P(ORBPLST(ORBPI),U,3)
99 ......I $D(ORBU) S ORBU(ORBUI)=" Orderer's pt list "_ORBTNAME_" ["_ORBTTYPE_"] recipients: ",ORBUI=ORBUI+1
100 ......N ORBLST2 D TEAMPROV^ORQPTQ1(.ORBLST2,ORBPTM)
101 ......Q:+$G(ORBLST2(1))<1
102 ......S ORBJ="" F S ORBJ=$O(ORBLST2(ORBJ)) Q:ORBJ="" D
103 .......S ORBDUZ=$P(ORBLST2(ORBJ),U)_U_ORBPTM I +$G(ORBDUZ)>0,($D(^XUSEC("ORES",+ORBDUZ))) D USER
104 Q
105ENTERBY ;
106 I $D(ORBU) S ORBU(ORBUI)=" User entering order's most recent activity:",ORBUI=ORBUI+1
107 Q:+$G(ORNUM)<1
108 I $D(^OR(100,ORNUM,8,0)) D
109 .S ORBDUZ=$P(^OR(100,ORNUM,8,$P(^OR(100,ORNUM,8,0),U,3),0),U,13)
110 I +$G(ORBDUZ)>0 D USER
111 Q
112PCMMPRIM ;
113 I $D(ORBU) S ORBU(ORBUI)=" PCMM Primary Care Practitioner:",ORBUI=ORBUI+1
114 S ORBDUZ=+$$OUTPTPR^SDUTL3(ORBDFN,$$NOW^XLFDT,1) ;DBIA #1252
115 I +$G(ORBDUZ)>0 D USER
116 Q
117PCMMASSC ;
118 I $D(ORBU) S ORBU(ORBUI)=" PCMM Associate Provider:",ORBUI=ORBUI+1
119 S ORBDUZ=+$$OUTPTAP^SDUTL3(ORBDFN,$$NOW^XLFDT) ;DBIA #1252
120 I +$G(ORBDUZ)>0 D USER
121 Q
122PCMMTEAM ;
123 N ORPCMM,ORPCMMDZ
124 I $D(ORBU) S ORBU(ORBUI)=" PCMM Team Position Assignments:",ORBUI=ORBUI+1
125 S ORPCMM=$$PRPT^SCAPMC(ORBDFN,,,,,,"^TMP(""ORPCMM"",$J)",) ;DBIA #1916
126 S ORPCMMDZ=0
127 F S ORPCMMDZ=$O(^TMP("ORPCMM",$J,"SCPR",ORPCMMDZ)) Q:'ORPCMMDZ D
128 .S ORBDUZ=ORPCMMDZ D USER
129 K ^TMP("ORPCMM",$J)
130 Q
131USER ;should USER (ORBDUZ) be a recip
132 I $P($$ONOFF^ORB3USER(ORN,+ORBDUZ,ORBDFN,,ORNUM),U)="ON" S XQA(+ORBDUZ)=""
133 Q
Note: See TracBrowser for help on using the repository browser.