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

CRHD1.m

Go to the documentation of this file.
  1. CRHD1 ; CAIRO/CLC - ADDED TO WORK WITH HAND OFF TEAM SECTION ;04-Mar-2008 16:00;CLC
  1. ;;1.0;CRHD;****;Jan 28, 2008;Build 19
  1. ;=================================================================
  1. DELENTS(CRHDRTN,CRHDTM,CRHDTY,CRHDP) ;
  1. ;delete a Hand off patient, provider, or team
  1. N DA,DIK
  1. K CRHDRTN
  1. S CRHDRTN=0
  1. N CRHDPIEN,CRHDN
  1. S CRHDN=$S(CRHDTY="P":1,1:2)
  1. S CRHDPIEN=$O(^CRHD(183.3,+CRHDTM,+CRHDN,"B",+CRHDP,0))
  1. I CRHDPIEN S DIK="^CRHD(183.3,"_+CRHDTM_","_+CRHDN_",",DA(1)=+CRHDTM,DA=CRHDPIEN D ^DIK S CRHDRTN=1
  1. Q
  1. HOTMMGR(CRHDRTN,DUZ) ;
  1. N CRHDKN,CRHDKEYS,CRHDOUT
  1. S CRHDRTN=0
  1. S CRHDKN=$$FIND1^DIC(19.1,"","X","CRHD HOT TEAM MGR","","","OUT")
  1. D GETS^DIQ(200,DUZ_",","51*","I","CRHDOUT")
  1. I CRHDKN>0 S CRHDRTN=$D(CRHDOUT(200.051,+CRHDKN_","_DUZ_","))
  1. Q
  1. HOTMMEM(CRHDRTN,CRHDTM,CRHDFRM,CRHDDIR,CRHDPFG) ;
  1. ;Return a set of providers from the HOT Team list.
  1. ;CRHDPFG - only return providers who have patients assigned to them
  1. N CRHDPLST,CRHDN,CRHDMAX,CRHDORI,CRHDTL,CRHDPATS
  1. K CRHDRTN
  1. S CRHDRTN=""
  1. I '$G(CRHDDIR) S CRHDDIR=1
  1. S CRHDORI=0,CRHDMAX=44
  1. I $G(CRHDPFG) D PP G NX
  1. D HODLIST^CRHD9(.CRHDPLST,CRHDTM)
  1. I $D(CRHDPLST) D
  1. .S CRHDN=0
  1. .F S CRHDN=$O(CRHDPLST(CRHDN)) Q:'CRHDN D
  1. ..S CRHDTL($P(CRHDPLST(CRHDN),"^",2))=CRHDPLST(CRHDN)
  1. NX I CRHDFRM'="",$D(CRHDTL(CRHDFRM)) S CRHDFRM=$E(CRHDFRM,1,$L(CRHDFRM)-1)
  1. S CRHDN=CRHDFRM
  1. F Q:CRHDORI'<CRHDMAX S CRHDN=$O(CRHDTL(CRHDN),CRHDDIR) Q:CRHDN="" D
  1. .S CRHDORI=CRHDORI+1,CRHDRTN(CRHDORI)=CRHDTL(CRHDN)
  1. Q
  1. PP ;
  1. N CRHDPATS,CRHDX
  1. K CRHDPATS D HOTPRVPT(.CRHDPATS,CRHDTM,"")
  1. I $D(CRHDPATS) D
  1. .S CRHDX=0
  1. .F S CRHDX=$O(CRHDPATS(CRHDX)) Q:'CRHDX D
  1. ..S:'$D(CRHDTL($P(CRHDPATS(CRHDX),"^",1))) CRHDTL($P(CRHDPATS(CRHDX),"^",1))=$P(CRHDPATS(CRHDX),"^",2)_"^"_$P(CRHDPATS(CRHDX),"^",1)
  1. Q
  1. HOTMMEMS(CRHDRTN,CRHDTM,CRHDFRM,CRHDDIR,CRHDCLAS) ;
  1. ;Return a subset of HO Team list
  1. ;CRHDCLAS
  1. ; ATTN:ATTENDING
  1. ; RES:RESIDENT
  1. ; INTERN:INTERN
  1. ; FELLOW:FELLOW
  1. ; STUD:MED STUDENT
  1. N CRHDPLST,CRHDN,CRHDMAX,CRHDORI,CRHDTL
  1. K CRHDRTN
  1. I '$G(CRHDDIR) S CRHDDIR=1
  1. S CRHDORI=0,CRHDMAX=44
  1. D HOTMMEM(.CRHDPLST,CRHDTM,CRHDFRM,CRHDDIR)
  1. I $D(CRHDPLST) D
  1. .S CRHDN=0
  1. .F S CRHDN=$O(CRHDPLST(CRHDN)) Q:'CRHDN D
  1. ..I $G(CRHDCLAS)'="" I $P(CRHDPLST(CRHDN),"^",3)=CRHDCLAS S CRHDTL($P(CRHDPLST(CRHDN),"^",2))=CRHDPLST(CRHDN)
  1. ..I $G(CRHDCLAS)="" S CRHDTL($P(CRHDPLST(CRHDN),"^",2))=CRHDPLST(CRHDN)
  1. F Q:CRHDORI'<CRHDMAX S CRHDN=$O(CRHDTL(CRHDN),CRHDDIR) Q:CRHDN="" D
  1. .S CRHDORI=CRHDORI+1,CRHDRTN(CRHDORI)=CRHDTL(CRHDN)
  1. Q
  1. HOTPRVPT(CRHDRTN,CRHDTM,CRHDPRV) ;
  1. ;return list of patients from the HO team list provider
  1. K CRHDRTN
  1. N CRHDPLST,CRHDORI,CRHDMAX,CRHDP,CRHDTMPL,CRHDCT,CRHDI,CRHDN,CRHDNN,CRHDNNN
  1. S CRHDORI=0,CRHDMAX=44
  1. D HOPLIST^CRHD9(.CRHDPLST,CRHDTM)
  1. I $D(CRHDPLST) D
  1. .S CRHDN=0,CRHDCT=0
  1. .F S CRHDN=$O(CRHDPLST(CRHDN)) Q:'CRHDN D
  1. ..S CRHDP=$P(CRHDPLST(CRHDN),"*",2)
  1. ..F CRHDI=2:1:$L(CRHDP,";") I +$P(CRHDP,";",CRHDI) D
  1. ...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
  1. ...I 'CRHDPRV S CRHDCT=CRHDCT+1,CRHDTMPL($P($P(CRHDP,";",CRHDI),"^",2),+$P(CRHDP,";",CRHDI),CRHDCT)=$P(CRHDPLST(CRHDN),"*",1)
  1. I $D(CRHDTMPL) D
  1. .S CRHDN=""
  1. .F Q:CRHDORI'<CRHDMAX S CRHDN=$O(CRHDTMPL(CRHDN)) Q:CRHDN="" D
  1. ..S CRHDNN=0
  1. ..F S CRHDNN=$O(CRHDTMPL(CRHDN,CRHDNN)) Q:'CRHDNN D
  1. ...S CRHDNNN=0
  1. ...F S CRHDNNN=$O(CRHDTMPL(CRHDN,CRHDNN,CRHDNNN)) Q:'CRHDNNN D
  1. ....S CRHDORI=CRHDORI+1,CRHDRTN(CRHDORI)=CRHDN_"^"_CRHDNN_"^"_CRHDTMPL(CRHDN,CRHDNN,CRHDNNN)
  1. Q