[613] | 1 | CRHD9 ; CAIRO/CLC - HANDOFF TEAM LIST ;4/24/08 12:49
|
---|
| 2 | ;;1.0;CRHD;****;Jan 28, 2008;Build 19
|
---|
| 3 | ;=================================================================
|
---|
| 4 | HOTMSAVE(CRHDRTN,CRHDTM) ;
|
---|
| 5 | ;create a team name
|
---|
| 6 | N CRHDFDA,CRHDOUT,CRHDERR
|
---|
| 7 | K CRHDRTN
|
---|
| 8 | S CRHDRTN=0
|
---|
| 9 | I (CRHDTM'?1A.E)&(CRHDTM'?1N.E) Q
|
---|
| 10 | S CRHDFDA(183.3,"?+1,",.01)=CRHDTM
|
---|
| 11 | D UPDATE^DIE("","CRHDFDA","CRHDOUT","CRHDERR")
|
---|
| 12 | I '$D(CRHDERR) S CRHDRTN=CRHDOUT(1)
|
---|
| 13 | Q
|
---|
| 14 | HOTMDEL(CRHDRTN,CRHDTM) ;
|
---|
| 15 | ;delete a Hand off team
|
---|
| 16 | N DIK,DA
|
---|
| 17 | K CRHDRTN
|
---|
| 18 | S CRHDRTN=0
|
---|
| 19 | I +CRHDTM S DIK="^CRHD(183.3,",DA=+CRHDTM D ^DIK S CRHDRTN=1
|
---|
| 20 | Q
|
---|
| 21 | HOLIST(CRHDRTN) ;
|
---|
| 22 | ;return a list of teams
|
---|
| 23 | N CRHDX,CRHDX1,CRHDTDT,CRHDCT
|
---|
| 24 | K CRHDRTN
|
---|
| 25 | S CRHDX=""
|
---|
| 26 | S CRHDCT=0
|
---|
| 27 | S CRHDRTN(0)="0^No List Found"
|
---|
| 28 | F S CRHDX=$O(^CRHD(183.3,"B",CRHDX)) Q:CRHDX="" D
|
---|
| 29 | .S CRHDX1=0
|
---|
| 30 | .F S CRHDX1=$O(^CRHD(183.3,"B",CRHDX,CRHDX1)) Q:'CRHDX1 D
|
---|
| 31 | ..;check to see if team list is active, if date is less then today then inactive
|
---|
| 32 | ..S CRHDTDT=$P($G(^CRHD(183.3,CRHDX1,0)),"^",2)
|
---|
| 33 | ..I CRHDTDT&(CRHDTDT<$$DT^XLFDT) Q
|
---|
| 34 | ..S CRHDCT=CRHDCT+1,CRHDRTN(CRHDCT)=CRHDX1_"^"_CRHDX_"^"_"HOTEAM"
|
---|
| 35 | I CRHDCT>0 K CRHDRTN(0)
|
---|
| 36 | Q
|
---|
| 37 | HOPLIST(CRHDRTN,CRHDTM) ;
|
---|
| 38 | ;Get list of Patients for a HO team
|
---|
| 39 | N CRHDX,CRHDPT,CRHDPD,CRHDTLST,CRHDCT,CRHDPD2,VAIP,DFN,DIE,DA,DR
|
---|
| 40 | K CRHDRTN
|
---|
| 41 | S CRHDRTN(1)="No Patients Found"
|
---|
| 42 | Q:'CRHDTM
|
---|
| 43 | I '$D(^CRHD(183.3,"B",$P(CRHDTM,"^",2),+CRHDTM)) Q
|
---|
| 44 | S CRHDX=0
|
---|
| 45 | F S CRHDX=$O(^CRHD(183.3,+CRHDTM,1,CRHDX)) Q:'CRHDX D
|
---|
| 46 | .S CRHDPT=+$G(^CRHD(183.3,+CRHDTM,1,CRHDX,0))
|
---|
| 47 | .;check to see if patient has been discharged, if so delete from list
|
---|
| 48 | .S DFN=CRHDPT D IN5^VADPT
|
---|
| 49 | .I VAIP(1)="" D Q
|
---|
| 50 | ..S DA(1)=+CRHDTM,DIE="^CRHD(183.3,"_DA(1)_",1,",DA=CRHDX,DR=".01///@" D ^DIE
|
---|
| 51 | .S CRHDPD=$$PATDATA(CRHDPT)
|
---|
| 52 | .K CRHDPD2
|
---|
| 53 | .D PATPRV(.CRHDPD2,CRHDTM,CRHDPT)
|
---|
| 54 | .I $P(CRHDPD,"^",2)'="" S CRHDTLST($P(CRHDPD,"^",2))=CRHDPD
|
---|
| 55 | .I $G(CRHDPD2)'="" S CRHDTLST($P(CRHDPD,"^",2))=CRHDTLST($P(CRHDPD,"^",2))_"^*"_CRHDPD2
|
---|
| 56 | I $D(CRHDTLST) D
|
---|
| 57 | .S CRHDCT=0
|
---|
| 58 | .S CRHDX=""
|
---|
| 59 | .F S CRHDX=$O(CRHDTLST(CRHDX)) Q:CRHDX="" S CRHDCT=CRHDCT+1,CRHDRTN(CRHDCT)=CRHDTLST(CRHDX)
|
---|
| 60 | Q
|
---|
| 61 | PATDATA(DFN) ;
|
---|
| 62 | ;
|
---|
| 63 | N CRHDNAME,CRHDSSN,CRHDDOB,CRHDAGE,CRHDSEX,VAIP,VADM
|
---|
| 64 | K VAIP,VADM
|
---|
| 65 | D DEM^VADPT,IN5^VADPT
|
---|
| 66 | S CRHDNAME=VADM(1),CRHDSSN=$P(VADM(2),U,1),CRHDDOB=$P(VADM(3),U,1)
|
---|
| 67 | S CRHDAGE=VADM(4),CRHDSEX=$P(VADM(5),U,1)
|
---|
| 68 | K VAIP,VADM
|
---|
| 69 | Q DFN_U_CRHDNAME_U_CRHDSSN_U_CRHDDOB_U_CRHDAGE_U_CRHDSEX
|
---|
| 70 | ;
|
---|
| 71 | HODLIST(CRHDRTN,CRHDTM) ;Get list of Providers for a HO team
|
---|
| 72 | N CRHDX,CRHDPRV,CRHDTLST,CRHDCT,CRHDZ0,CRHDSORT,CRHDUT
|
---|
| 73 | N CRHDPX,CRHDPX0,CRHDNAM
|
---|
| 74 | K CRHDRTN
|
---|
| 75 | I '$D(^CRHD(183.3,"B",$P(CRHDTM,"^",2),+CRHDTM)) Q
|
---|
| 76 | S CRHDX=0
|
---|
| 77 | F S CRHDX=$O(^CRHD(183.3,+CRHDTM,2,CRHDX)) Q:'CRHDX D
|
---|
| 78 | .S CRHDPRV=+$G(^CRHD(183.3,+CRHDTM,2,CRHDX,0))
|
---|
| 79 | .S CRHDNAM=$$GET1^DIQ(200,+CRHDPRV,.01,"E")
|
---|
| 80 | .;Delete Provider if inactive, 1st check to see if assigned to a patient, if so remove
|
---|
| 81 | .I '$$ACTIVE^XUSER(+CRHDPRV) D Q
|
---|
| 82 | ..S CRHDPX=0 F S CRHDPX=$O(^CRHD(183.3,+CRHDTM,1,CRHDPX)) Q:'CRHDPX D
|
---|
| 83 | ...S CRHDPX0=^CRHD(183.3,+CRHDTM,1,CRHDPX,0)
|
---|
| 84 | ...I CRHDPX0[+CRHDPRV F CRHDI=2:1:$L(CRHDPX0,"^") I $P(CRHDPX0,"^",CRHDI)=+CRHDPRV S $P(^CRHD(183.3,+CRHDTM,1,CRHDPX,0),"^",CRHDI)=""
|
---|
| 85 | ..S DA(1)=+CRHDTM,DIE="^CRHD(183.3,"_DA(1)_",2,",DA=CRHDX,DR=".01///@" D ^DIE
|
---|
| 86 | .I CRHDNAM'="" D
|
---|
| 87 | ..S CRHDZ0=$G(^CRHD(183.3,+CRHDTM,2,+CRHDX,0))
|
---|
| 88 | ..S CRHDUT=$P(CRHDZ0,"^",2)
|
---|
| 89 | ..I CRHDUT="" S CRHDUT="ZNOTYPE"
|
---|
| 90 | ..S CRHDSORT(CRHDUT,CRHDNAM)=CRHDPRV_"^"_CRHDNAM_"^"_$P(CRHDZ0,"^",2)_"^"_+$P(CRHDZ0,"^",3)_"^"_+$P(CRHDZ0,"^",4)_"^"_$P(CRHDZ0,"^",5)_"^"_$P(CRHDZ0,"^",6)
|
---|
| 91 | S CRHDI=""
|
---|
| 92 | F S CRHDI=$O(CRHDSORT(CRHDI)) Q:CRHDI="" D
|
---|
| 93 | .S CRHDPRV=""
|
---|
| 94 | .F S CRHDPRV=$O(CRHDSORT(CRHDI,CRHDPRV)) Q:CRHDPRV="" D
|
---|
| 95 | ..S CRHDTLST(CRHDPRV)=CRHDSORT(CRHDI,CRHDPRV)
|
---|
| 96 | ..;S CRHDTLST(CRHDNAM)=CRHDPRV_"^"_CRHDNAM_"^"_$P(CRHDZ0,"^",2)_"^"_+$P(CRHDZ0,"^",3)_"^"_+$P(CRHDZ0,"^",4)_"^"_$P(CRHDZ0,"^",5)_"^"_$P(CRHDZ0,"^",6)
|
---|
| 97 | I $D(CRHDTLST) D
|
---|
| 98 | .S CRHDCT=0
|
---|
| 99 | .S CRHDX=""
|
---|
| 100 | .F S CRHDX=$O(CRHDTLST(CRHDX)) Q:CRHDX="" S CRHDCT=CRHDCT+1,CRHDRTN(CRHDCT)=CRHDTLST(CRHDX)
|
---|
| 101 | Q
|
---|
| 102 | CANEDIT(CRHDRTN,CRHDTM,DUZ) ;
|
---|
| 103 | ;Can user edit team list
|
---|
| 104 | N CRHDPRV,CRHDMGR,CRHDA
|
---|
| 105 | Q:CRHDTM=""
|
---|
| 106 | ;S CRHDRTN="1^1"
|
---|
| 107 | S CRHDA=$$GET1^DIQ(200,+DUZ,3,"I")
|
---|
| 108 | S CRHDRTN="0^0"
|
---|
| 109 | I CRHDA["@" S CRHDRTN="1^1" Q
|
---|
| 110 | D HOTMMGR^CRHD1(.CRHDMGR,DUZ)
|
---|
| 111 | I CRHDMGR S CRHDRTN="1^1" Q
|
---|
| 112 | S CRHDPRV=$O(^CRHD(183.3,+CRHDTM,2,"B",+DUZ,0))
|
---|
| 113 | I 'CRHDPRV Q
|
---|
| 114 | E S CRHDRTN=+$P($G(^CRHD(183.3,+CRHDTM,2,+CRHDPRV,0)),"^",3)_"^"_+$P($G(^CRHD(183.3,+CRHDTM,2,+CRHDPRV,0)),"^",4)
|
---|
| 115 | Q
|
---|
| 116 | PATPRV(CRHDRTN,CRHDTM,CRHDDFN) ;
|
---|
| 117 | ;return Providers assigned to patient on list
|
---|
| 118 | N CRHDPAT,CRHDNAM,CRHDZ0,CRHDP,CRHDATTN,CRHDRES,CRHDINT,CRHDFEL,CRHDMST,CRHDNUR,CRHDVP,CRHDI,CRHDI2
|
---|
| 119 | S CRHDVP="^CRHDATTN^CRHDRES^CRHDINT^CRHDFEL^CRHDMST^CRHDNUR"
|
---|
| 120 | S CRHDPAT=$O(^CRHD(183.3,+CRHDTM,1,"B",+CRHDDFN,0))
|
---|
| 121 | I 'CRHDPAT Q
|
---|
| 122 | S CRHDZ0=$G(^CRHD(183.3,+CRHDTM,1,+CRHDPAT,0))
|
---|
| 123 | ;I need to add, if the physician is not on team list delete from patient.
|
---|
| 124 | F CRHDI=2:1:7 S CRHDP=$P(CRHDZ0,"^",CRHDI) D
|
---|
| 125 | .I '$D(@$P(CRHDVP,"^",CRHDI)) S @$P(CRHDVP,"^",CRHDI)=""
|
---|
| 126 | .I CRHDP["," D
|
---|
| 127 | ..F CRHDI2=1:1:$L(CRHDP,",") D
|
---|
| 128 | ...I '$D(^CRHD(183.3,CRHDTM,2,"B",$P(CRHDP,",",CRHDI2))) Q
|
---|
| 129 | ...S CRHDNAM=$$GET1^DIQ(200,+$P(CRHDP,",",CRHDI2),.01,"E")
|
---|
| 130 | ...S @$P(CRHDVP,"^",CRHDI)=@$P(CRHDVP,"^",CRHDI)_+$P(CRHDP,",",CRHDI2)_"^"_CRHDNAM_"+"
|
---|
| 131 | .;E S:+CRHDP&($D(^CRHD(183.3,+CRHDTM,2,"B",+CRHDP))) @$P(CRHDVP,"^",CRHDI)=+CRHDP_"^"_$$GET1^DIQ(200,+CRHDP,.01,"E")
|
---|
| 132 | .E S:+CRHDP @$P(CRHDVP,"^",CRHDI)=+CRHDP_"^"_$$GET1^DIQ(200,+CRHDP,.01,"E")
|
---|
| 133 | F CRHDI=2:1:7 I $E(@$P(CRHDVP,"^",CRHDI),$L(@$P(CRHDVP,"^",CRHDI)))="+" S @$P(CRHDVP,"^",CRHDI)=$E(@$P(CRHDVP,"^",CRHDI),1,$L(@$P(CRHDVP,"^",CRHDI))-1)
|
---|
| 134 | S CRHDRTN=CRHDDFN_";"_$G(CRHDATTN)_";"_$G(CRHDRES)_";"_$G(CRHDINT)_";"_$G(CRHDFEL)_";"_$G(CRHDMST)_";"_$G(CRHDNUR)
|
---|
| 135 | Q
|
---|
| 136 | USERPHPG(CRHDRTN,DUZ) ;
|
---|
| 137 | N CRHDOP,CRHDPG
|
---|
| 138 | S CRHDOP=$$GET1^DIQ(200,+DUZ_",",.132,"E") ;OFFICE PHONE
|
---|
| 139 | S CRHDPG=$$GET1^DIQ(200,+DUZ_",",.138,"E") ;PAGER
|
---|
| 140 | S CRHDRTN=$S($L(CRHDOP)>2:CRHDOP,1:"")_"^"_$S($L(CRHDPG)>2:CRHDPG,1:"")
|
---|
| 141 | Q
|
---|
| 142 | PRVINFO(CRHDRTN,CRHDTM,DUZ) ;
|
---|
| 143 | ;return user information
|
---|
| 144 | N CRHDPRV,CRHDZ0,CRHDMGR
|
---|
| 145 | Q:CRHDTM=""
|
---|
| 146 | ;S CRHDRTN(1)="0^0"
|
---|
| 147 | S CRHDPRV=$O(^CRHD(183.3,+CRHDTM,2,"B",+DUZ,0))
|
---|
| 148 | I 'CRHDPRV Q
|
---|
| 149 | S CRHDZ0=$G(^CRHD(183.3,+CRHDTM,2,+CRHDPRV,0))
|
---|
| 150 | D MGR^CRHD7(.CRHDMGR,DUZ)
|
---|
| 151 | I ($$GET1^DIQ(200,+DUZ,3,"E")["@")!(+CRHDMGR) S $P(CRHDZ0,"^",3)=1,$P(CRHDZ0,"^",4)=1
|
---|
| 152 | S CRHDRTN=$P(CRHDZ0,"^",1)_"^"_$$GET1^DIQ(200,+CRHDZ0,.01,"E")_"^"_$P(CRHDZ0,"^",2,$L(CRHDZ0,"^"))
|
---|
| 153 | Q
|
---|
| 154 | MOD(CRHDRTN,CRHDTM,CRHDLTYP,CRHDTXT,CRHDKFG) ;
|
---|
| 155 | N CRHDX,CRHDFDA,CRHDOUT,CRHDERR
|
---|
| 156 | K CRHDRTN
|
---|
| 157 | S CRHDRTN(0)=0
|
---|
| 158 | I '$D(^CRHD(183.3,"B",$P(CRHDTM,"^",2),+CRHDTM)) Q
|
---|
| 159 | I CRHDLTYP="P" D
|
---|
| 160 | .K:CRHDKFG ^CRHD(183.3,+CRHDTM,1)
|
---|
| 161 | .S CRHDX=0
|
---|
| 162 | .F S CRHDX=$O(CRHDTXT(CRHDX)) Q:'CRHDX D
|
---|
| 163 | ..I CRHDTXT(CRHDX)["~" S CRHDTXT(CRHDX)=$P(CRHDTXT(CRHDX),"~",2)
|
---|
| 164 | ..S CRHDFDA(183.31,"?+"_(CRHDX+1)_","_+CRHDTM_","_"",.01)=+$P(CRHDTXT(CRHDX),"^",1)
|
---|
| 165 | ..S CRHDFDA(183.31,"?+"_(CRHDX+1)_","_+CRHDTM_","_"",1)=+$P(CRHDTXT(CRHDX),";",2)
|
---|
| 166 | ..S CRHDFDA(183.31,"?+"_(CRHDX+1)_","_+CRHDTM_","_"",2)=+$P(CRHDTXT(CRHDX),";",3)
|
---|
| 167 | ..S CRHDFDA(183.31,"?+"_(CRHDX+1)_","_+CRHDTM_","_"",3)=+$P(CRHDTXT(CRHDX),";",4)
|
---|
| 168 | ..S CRHDFDA(183.31,"?+"_(CRHDX+1)_","_+CRHDTM_","_"",4)=+$P(CRHDTXT(CRHDX),";",5)
|
---|
| 169 | ..S CRHDFDA(183.31,"?+"_(CRHDX+1)_","_+CRHDTM_","_"",5)=+$P(CRHDTXT(CRHDX),";",6)
|
---|
| 170 | ..S CRHDFDA(183.31,"?+"_(CRHDX+1)_","_+CRHDTM_","_"",6)=+$P(CRHDTXT(CRHDX),";",7)
|
---|
| 171 | .D UPDATE^DIE("","CRHDFDA","CRHDOUT","CRHDERR")
|
---|
| 172 | .I '$D(CRHDERR) S CRHDRTN(0)=1
|
---|
| 173 | .E S CRHDRTN(1)=1
|
---|
| 174 | I CRHDLTYP="D" D
|
---|
| 175 | .K:CRHDKFG ^CRHD(183.3,+CRHDTM,2)
|
---|
| 176 | .S CRHDX=0
|
---|
| 177 | .F S CRHDX=$O(CRHDTXT(CRHDX)) Q:'CRHDX D
|
---|
| 178 | ..I CRHDTXT(CRHDX)["~" S CRHDTXT(CRHDX)=$P(CRHDTXT(CRHDX),"~",2)
|
---|
| 179 | ..S CRHDFDA(183.32,"?+"_(CRHDX+1)_","_+CRHDTM_","_"",.01)=$P(CRHDTXT(CRHDX),"^",1)
|
---|
| 180 | ..S CRHDFDA(183.32,"?+"_(CRHDX+1)_","_+CRHDTM_","_"",1)=$P(CRHDTXT(CRHDX),"^",3)
|
---|
| 181 | ..S CRHDFDA(183.32,"?+"_(CRHDX+1)_","_+CRHDTM_","_"",2)=$P(CRHDTXT(CRHDX),"^",4)
|
---|
| 182 | ..S CRHDFDA(183.32,"?+"_(CRHDX+1)_","_+CRHDTM_","_"",3)=$P(CRHDTXT(CRHDX),"^",5)
|
---|
| 183 | ..S CRHDFDA(183.32,"?+"_(CRHDX+1)_","_+CRHDTM_","_"",4)=$P(CRHDTXT(CRHDX),"^",6)
|
---|
| 184 | ..S CRHDFDA(183.32,"?+"_(CRHDX+1)_","_+CRHDTM_","_"",5)=$P(CRHDTXT(CRHDX),"^",7)
|
---|
| 185 | .D UPDATE^DIE("","CRHDFDA","CRHDOUT","CRHDERR")
|
---|
| 186 | .I '$D(CRHDERR) S CRHDRTN(0)=1
|
---|
| 187 | .E S CRHDRTN(1)=1
|
---|
| 188 | K CRHDFDA,CRHDOUT,CRHDERR
|
---|
| 189 | Q
|
---|
| 190 | FILENSAV(CRHDRTN,CRHDTM,CRHDFNM) ;
|
---|
| 191 | ;save filename for a team
|
---|
| 192 | N CRHDFDA,CRHDOUT,CRHDERR,CRHDA
|
---|
| 193 | K CRHDRTN
|
---|
| 194 | S CRHDRTN=0
|
---|
| 195 | ;I CRHDTM'?1A.E Q
|
---|
| 196 | S CRHDFDA(183.4,"?+1,",.01)=$P(CRHDTM,"^",2)
|
---|
| 197 | D UPDATE^DIE("","CRHDFDA","CRHDOUT","CRHDERR")
|
---|
| 198 | I '$D(CRHDERR) D
|
---|
| 199 | .S CRHDA=CRHDOUT(1)
|
---|
| 200 | .K CRHDFDA,CRHDOUT
|
---|
| 201 | .I CRHDA D
|
---|
| 202 | ..S CRHDFDA(183.4,CRHDA_",",2)=CRHDFNM
|
---|
| 203 | ..D FILE^DIE("","CRHDFDA")
|
---|
| 204 | ..S CRHDRTN=1
|
---|
| 205 | Q
|
---|
| 206 | FILENGET(CRHDRTN,CRHDTM) ;
|
---|
| 207 | ;get filename for a team
|
---|
| 208 | S CRHDRTN=$$GET1^DIQ(183.4,+$$FIND1^DIC(183.4,"","X",$P(CRHDTM,"^",2),"","","ERR")_",",2,"I")
|
---|
| 209 | Q
|
---|