source: WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/CRHD1.m@ 1361

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

initial load of WorldVistAEHR
File size: 3.4 KB
RevLine 
[613]1CRHD1 ; CAIRO/CLC - ADDED TO WORK WITH HAND OFF TEAM SECTION ;04-Mar-2008 16:00;CLC
2 ;;1.0;CRHD;****;Jan 28, 2008;Build 19
3 ;=================================================================
4DELENTS(CRHDRTN,CRHDTM,CRHDTY,CRHDP) ;
5 ;delete a Hand off patient, provider, or team
6 N DA,DIK
7 K CRHDRTN
8 S CRHDRTN=0
9 N CRHDPIEN,CRHDN
10 S CRHDN=$S(CRHDTY="P":1,1:2)
11 S CRHDPIEN=$O(^CRHD(183.3,+CRHDTM,+CRHDN,"B",+CRHDP,0))
12 I CRHDPIEN S DIK="^CRHD(183.3,"_+CRHDTM_","_+CRHDN_",",DA(1)=+CRHDTM,DA=CRHDPIEN D ^DIK S CRHDRTN=1
13 Q
14HOTMMGR(CRHDRTN,DUZ) ;
15 N CRHDKN,CRHDKEYS,CRHDOUT
16 S CRHDRTN=0
17 S CRHDKN=$$FIND1^DIC(19.1,"","X","CRHD HOT TEAM MGR","","","OUT")
18 D GETS^DIQ(200,DUZ_",","51*","I","CRHDOUT")
19 I CRHDKN>0 S CRHDRTN=$D(CRHDOUT(200.051,+CRHDKN_","_DUZ_","))
20 Q
21HOTMMEM(CRHDRTN,CRHDTM,CRHDFRM,CRHDDIR,CRHDPFG) ;
22 ;Return a set of providers from the HOT Team list.
23 ;CRHDPFG - only return providers who have patients assigned to them
24 N CRHDPLST,CRHDN,CRHDMAX,CRHDORI,CRHDTL,CRHDPATS
25 K CRHDRTN
26 S CRHDRTN=""
27 I '$G(CRHDDIR) S CRHDDIR=1
28 S CRHDORI=0,CRHDMAX=44
29 I $G(CRHDPFG) D PP G NX
30 D HODLIST^CRHD9(.CRHDPLST,CRHDTM)
31 I $D(CRHDPLST) D
32 .S CRHDN=0
33 .F S CRHDN=$O(CRHDPLST(CRHDN)) Q:'CRHDN D
34 ..S CRHDTL($P(CRHDPLST(CRHDN),"^",2))=CRHDPLST(CRHDN)
35NX I CRHDFRM'="",$D(CRHDTL(CRHDFRM)) S CRHDFRM=$E(CRHDFRM,1,$L(CRHDFRM)-1)
36 S CRHDN=CRHDFRM
37 F Q:CRHDORI'<CRHDMAX S CRHDN=$O(CRHDTL(CRHDN),CRHDDIR) Q:CRHDN="" D
38 .S CRHDORI=CRHDORI+1,CRHDRTN(CRHDORI)=CRHDTL(CRHDN)
39 Q
40PP ;
41 N CRHDPATS,CRHDX
42 K CRHDPATS D HOTPRVPT(.CRHDPATS,CRHDTM,"")
43 I $D(CRHDPATS) D
44 .S CRHDX=0
45 .F S CRHDX=$O(CRHDPATS(CRHDX)) Q:'CRHDX D
46 ..S:'$D(CRHDTL($P(CRHDPATS(CRHDX),"^",1))) CRHDTL($P(CRHDPATS(CRHDX),"^",1))=$P(CRHDPATS(CRHDX),"^",2)_"^"_$P(CRHDPATS(CRHDX),"^",1)
47 Q
48HOTMMEMS(CRHDRTN,CRHDTM,CRHDFRM,CRHDDIR,CRHDCLAS) ;
49 ;Return a subset of HO Team list
50 ;CRHDCLAS
51 ; ATTN:ATTENDING
52 ; RES:RESIDENT
53 ; INTERN:INTERN
54 ; FELLOW:FELLOW
55 ; STUD:MED STUDENT
56 N CRHDPLST,CRHDN,CRHDMAX,CRHDORI,CRHDTL
57 K CRHDRTN
58 I '$G(CRHDDIR) S CRHDDIR=1
59 S CRHDORI=0,CRHDMAX=44
60 D HOTMMEM(.CRHDPLST,CRHDTM,CRHDFRM,CRHDDIR)
61 I $D(CRHDPLST) D
62 .S CRHDN=0
63 .F S CRHDN=$O(CRHDPLST(CRHDN)) Q:'CRHDN D
64 ..I $G(CRHDCLAS)'="" I $P(CRHDPLST(CRHDN),"^",3)=CRHDCLAS S CRHDTL($P(CRHDPLST(CRHDN),"^",2))=CRHDPLST(CRHDN)
65 ..I $G(CRHDCLAS)="" S CRHDTL($P(CRHDPLST(CRHDN),"^",2))=CRHDPLST(CRHDN)
66 F Q:CRHDORI'<CRHDMAX S CRHDN=$O(CRHDTL(CRHDN),CRHDDIR) Q:CRHDN="" D
67 .S CRHDORI=CRHDORI+1,CRHDRTN(CRHDORI)=CRHDTL(CRHDN)
68 Q
69HOTPRVPT(CRHDRTN,CRHDTM,CRHDPRV) ;
70 ;return list of patients from the HO team list provider
71 K CRHDRTN
72 N CRHDPLST,CRHDORI,CRHDMAX,CRHDP,CRHDTMPL,CRHDCT,CRHDI,CRHDN,CRHDNN,CRHDNNN
73 S CRHDORI=0,CRHDMAX=44
74 D HOPLIST^CRHD9(.CRHDPLST,CRHDTM)
75 I $D(CRHDPLST) D
76 .S CRHDN=0,CRHDCT=0
77 .F S CRHDN=$O(CRHDPLST(CRHDN)) Q:'CRHDN D
78 ..S CRHDP=$P(CRHDPLST(CRHDN),"*",2)
79 ..F CRHDI=2:1:$L(CRHDP,";") I +$P(CRHDP,";",CRHDI) D
80 ...I +CRHDPRV I +CRHDPRV=+$P(CRHDP,";",CRHDI) S CRHDCT=CRHDCT+1,CRHDTMPL($P($P(CRHDP,";",CRHDI),"^",2),+$P(CRHDP,";",CRHDI),CRHDCT)=$P(CRHDPLST(CRHDN),"*",1) Q
81 ...I 'CRHDPRV S CRHDCT=CRHDCT+1,CRHDTMPL($P($P(CRHDP,";",CRHDI),"^",2),+$P(CRHDP,";",CRHDI),CRHDCT)=$P(CRHDPLST(CRHDN),"*",1)
82 I $D(CRHDTMPL) D
83 .S CRHDN=""
84 .F Q:CRHDORI'<CRHDMAX S CRHDN=$O(CRHDTMPL(CRHDN)) Q:CRHDN="" D
85 ..S CRHDNN=0
86 ..F S CRHDNN=$O(CRHDTMPL(CRHDN,CRHDNN)) Q:'CRHDNN D
87 ...S CRHDNNN=0
88 ...F S CRHDNNN=$O(CRHDTMPL(CRHDN,CRHDNN,CRHDNNN)) Q:'CRHDNNN D
89 ....S CRHDORI=CRHDORI+1,CRHDRTN(CRHDORI)=CRHDN_"^"_CRHDNN_"^"_CRHDTMPL(CRHDN,CRHDNN,CRHDNNN)
90 Q
Note: See TracBrowser for help on using the repository browser.