CRHD1 ; CAIRO/CLC - ADDED TO WORK WITH HAND OFF TEAM SECTION ;04-Mar-2008 16:00;CLC
;;1.0;CRHD;****;Jan 28, 2008;Build 19
;=================================================================
DELENTS(CRHDRTN,CRHDTM,CRHDTY,CRHDP) ;
;delete a Hand off patient, provider, or team
N DA,DIK
K CRHDRTN
S CRHDRTN=0
N CRHDPIEN,CRHDN
S CRHDN=$S(CRHDTY="P":1,1:2)
S CRHDPIEN=$O(^CRHD(183.3,+CRHDTM,+CRHDN,"B",+CRHDP,0))
I CRHDPIEN S DIK="^CRHD(183.3,"_+CRHDTM_","_+CRHDN_",",DA(1)=+CRHDTM,DA=CRHDPIEN D ^DIK S CRHDRTN=1
Q
HOTMMGR(CRHDRTN,DUZ) ;
N CRHDKN,CRHDKEYS,CRHDOUT
S CRHDRTN=0
S CRHDKN=$$FIND1^DIC(19.1,"","X","CRHD HOT TEAM MGR","","","OUT")
D GETS^DIQ(200,DUZ_",","51*","I","CRHDOUT")
I CRHDKN>0 S CRHDRTN=$D(CRHDOUT(200.051,+CRHDKN_","_DUZ_","))
Q
HOTMMEM(CRHDRTN,CRHDTM,CRHDFRM,CRHDDIR,CRHDPFG) ;
;Return a set of providers from the HOT Team list.
;CRHDPFG - only return providers who have patients assigned to them
N CRHDPLST,CRHDN,CRHDMAX,CRHDORI,CRHDTL,CRHDPATS
K CRHDRTN
S CRHDRTN=""
I '$G(CRHDDIR) S CRHDDIR=1
S CRHDORI=0,CRHDMAX=44
I $G(CRHDPFG) D PP G NX
D HODLIST^CRHD9(.CRHDPLST,CRHDTM)
I $D(CRHDPLST) D
.S CRHDN=0
.F S CRHDN=$O(CRHDPLST(CRHDN)) Q:'CRHDN D
..S CRHDTL($P(CRHDPLST(CRHDN),"^",2))=CRHDPLST(CRHDN)
NX I CRHDFRM'="",$D(CRHDTL(CRHDFRM)) S CRHDFRM=$E(CRHDFRM,1,$L(CRHDFRM)-1)
S CRHDN=CRHDFRM
F Q:CRHDORI'<CRHDMAX S CRHDN=$O(CRHDTL(CRHDN),CRHDDIR) Q:CRHDN="" D
.S CRHDORI=CRHDORI+1,CRHDRTN(CRHDORI)=CRHDTL(CRHDN)
Q
PP ;
N CRHDPATS,CRHDX
K CRHDPATS D HOTPRVPT(.CRHDPATS,CRHDTM,"")
I $D(CRHDPATS) D
.S CRHDX=0
.F S CRHDX=$O(CRHDPATS(CRHDX)) Q:'CRHDX D
..S:'$D(CRHDTL($P(CRHDPATS(CRHDX),"^",1))) CRHDTL($P(CRHDPATS(CRHDX),"^",1))=$P(CRHDPATS(CRHDX),"^",2)_"^"_$P(CRHDPATS(CRHDX),"^",1)
Q
HOTMMEMS(CRHDRTN,CRHDTM,CRHDFRM,CRHDDIR,CRHDCLAS) ;
;Return a subset of HO Team list
;CRHDCLAS
; ATTN:ATTENDING
; RES:RESIDENT
; INTERN:INTERN
; FELLOW:FELLOW
; STUD:MED STUDENT
N CRHDPLST,CRHDN,CRHDMAX,CRHDORI,CRHDTL
K CRHDRTN
I '$G(CRHDDIR) S CRHDDIR=1
S CRHDORI=0,CRHDMAX=44
D HOTMMEM(.CRHDPLST,CRHDTM,CRHDFRM,CRHDDIR)
I $D(CRHDPLST) D
.S CRHDN=0
.F S CRHDN=$O(CRHDPLST(CRHDN)) Q:'CRHDN D
..I $G(CRHDCLAS)'="" I $P(CRHDPLST(CRHDN),"^",3)=CRHDCLAS S CRHDTL($P(CRHDPLST(CRHDN),"^",2))=CRHDPLST(CRHDN)
..I $G(CRHDCLAS)="" S CRHDTL($P(CRHDPLST(CRHDN),"^",2))=CRHDPLST(CRHDN)
F Q:CRHDORI'<CRHDMAX S CRHDN=$O(CRHDTL(CRHDN),CRHDDIR) Q:CRHDN="" D
.S CRHDORI=CRHDORI+1,CRHDRTN(CRHDORI)=CRHDTL(CRHDN)
Q
HOTPRVPT(CRHDRTN,CRHDTM,CRHDPRV) ;
;return list of patients from the HO team list provider
K CRHDRTN
N CRHDPLST,CRHDORI,CRHDMAX,CRHDP,CRHDTMPL,CRHDCT,CRHDI,CRHDN,CRHDNN,CRHDNNN
S CRHDORI=0,CRHDMAX=44
D HOPLIST^CRHD9(.CRHDPLST,CRHDTM)
I $D(CRHDPLST) D
.S CRHDN=0,CRHDCT=0
.F S CRHDN=$O(CRHDPLST(CRHDN)) Q:'CRHDN D
..S CRHDP=$P(CRHDPLST(CRHDN),"*",2)
..F CRHDI=2:1:$L(CRHDP,";") I +$P(CRHDP,";",CRHDI) D
...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
...I 'CRHDPRV S CRHDCT=CRHDCT+1,CRHDTMPL($P($P(CRHDP,";",CRHDI),"^",2),+$P(CRHDP,";",CRHDI),CRHDCT)=$P(CRHDPLST(CRHDN),"*",1)
I $D(CRHDTMPL) D
.S CRHDN=""
.F Q:CRHDORI'<CRHDMAX S CRHDN=$O(CRHDTMPL(CRHDN)) Q:CRHDN="" D
..S CRHDNN=0
..F S CRHDNN=$O(CRHDTMPL(CRHDN,CRHDNN)) Q:'CRHDNN D
...S CRHDNNN=0
...F S CRHDNNN=$O(CRHDTMPL(CRHDN,CRHDNN,CRHDNNN)) Q:'CRHDNNN D
....S CRHDORI=CRHDORI+1,CRHDRTN(CRHDORI)=CRHDN_"^"_CRHDNN_"^"_CRHDTMPL(CRHDN,CRHDNN,CRHDNNN)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HCRHD1 3622 printed Apr 09, 2024@21:40:23 Page 2
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
+2 ;=================================================================
DELENTS(CRHDRTN,CRHDTM,CRHDTY,CRHDP) ;
+1 ;delete a Hand off patient, provider, or team
+2 NEW DA,DIK
+3 KILL CRHDRTN
+4 SET CRHDRTN=0
+5 NEW CRHDPIEN,CRHDN
+6 SET CRHDN=$SELECT(CRHDTY="P":1,1:2)
+7 SET CRHDPIEN=$ORDER(^CRHD(183.3,+CRHDTM,+CRHDN,"B",+CRHDP,0))
+8 IF CRHDPIEN
SET DIK="^CRHD(183.3,"_+CRHDTM_","_+CRHDN_","
SET DA(1)=+CRHDTM
SET DA=CRHDPIEN
DO ^DIK
SET CRHDRTN=1
+9 QUIT
HOTMMGR(CRHDRTN,DUZ) ;
+1 NEW CRHDKN,CRHDKEYS,CRHDOUT
+2 SET CRHDRTN=0
+3 SET CRHDKN=$$FIND1^DIC(19.1,"","X","CRHD HOT TEAM MGR","","","OUT")
+4 DO GETS^DIQ(200,DUZ_",","51*","I","CRHDOUT")
+5 IF CRHDKN>0
SET CRHDRTN=$DATA(CRHDOUT(200.051,+CRHDKN_","_DUZ_","))
+6 QUIT
HOTMMEM(CRHDRTN,CRHDTM,CRHDFRM,CRHDDIR,CRHDPFG) ;
+1 ;Return a set of providers from the HOT Team list.
+2 ;CRHDPFG - only return providers who have patients assigned to them
+3 NEW CRHDPLST,CRHDN,CRHDMAX,CRHDORI,CRHDTL,CRHDPATS
+4 KILL CRHDRTN
+5 SET CRHDRTN=""
+6 IF '$GET(CRHDDIR)
SET CRHDDIR=1
+7 SET CRHDORI=0
SET CRHDMAX=44
+8 IF $GET(CRHDPFG)
DO PP
GOTO NX
+9 DO HODLIST^CRHD9(.CRHDPLST,CRHDTM)
+10 IF $DATA(CRHDPLST)
Begin DoDot:1
+11 SET CRHDN=0
+12 FOR
SET CRHDN=$ORDER(CRHDPLST(CRHDN))
if 'CRHDN
QUIT
Begin DoDot:2
+13 SET CRHDTL($PIECE(CRHDPLST(CRHDN),"^",2))=CRHDPLST(CRHDN)
End DoDot:2
End DoDot:1
NX IF CRHDFRM'=""
IF $DATA(CRHDTL(CRHDFRM))
SET CRHDFRM=$EXTRACT(CRHDFRM,1,$LENGTH(CRHDFRM)-1)
+1 SET CRHDN=CRHDFRM
+2 FOR
if CRHDORI'<CRHDMAX
QUIT
SET CRHDN=$ORDER(CRHDTL(CRHDN),CRHDDIR)
if CRHDN=""
QUIT
Begin DoDot:1
+3 SET CRHDORI=CRHDORI+1
SET CRHDRTN(CRHDORI)=CRHDTL(CRHDN)
End DoDot:1
+4 QUIT
PP ;
+1 NEW CRHDPATS,CRHDX
+2 KILL CRHDPATS
DO HOTPRVPT(.CRHDPATS,CRHDTM,"")
+3 IF $DATA(CRHDPATS)
Begin DoDot:1
+4 SET CRHDX=0
+5 FOR
SET CRHDX=$ORDER(CRHDPATS(CRHDX))
if 'CRHDX
QUIT
Begin DoDot:2
+6 if '$DATA(CRHDTL($PIECE(CRHDPATS(CRHDX),"^",1)))
SET CRHDTL($PIECE(CRHDPATS(CRHDX),"^",1))=$PIECE(CRHDPATS(CRHDX),"^",2)_"^"_$PIECE(CRHDPATS(CRHDX),"^",1)
End DoDot:2
End DoDot:1
+7 QUIT
HOTMMEMS(CRHDRTN,CRHDTM,CRHDFRM,CRHDDIR,CRHDCLAS) ;
+1 ;Return a subset of HO Team list
+2 ;CRHDCLAS
+3 ; ATTN:ATTENDING
+4 ; RES:RESIDENT
+5 ; INTERN:INTERN
+6 ; FELLOW:FELLOW
+7 ; STUD:MED STUDENT
+8 NEW CRHDPLST,CRHDN,CRHDMAX,CRHDORI,CRHDTL
+9 KILL CRHDRTN
+10 IF '$GET(CRHDDIR)
SET CRHDDIR=1
+11 SET CRHDORI=0
SET CRHDMAX=44
+12 DO HOTMMEM(.CRHDPLST,CRHDTM,CRHDFRM,CRHDDIR)
+13 IF $DATA(CRHDPLST)
Begin DoDot:1
+14 SET CRHDN=0
+15 FOR
SET CRHDN=$ORDER(CRHDPLST(CRHDN))
if 'CRHDN
QUIT
Begin DoDot:2
+16 IF $GET(CRHDCLAS)'=""
IF $PIECE(CRHDPLST(CRHDN),"^",3)=CRHDCLAS
SET CRHDTL($PIECE(CRHDPLST(CRHDN),"^",2))=CRHDPLST(CRHDN)
+17 IF $GET(CRHDCLAS)=""
SET CRHDTL($PIECE(CRHDPLST(CRHDN),"^",2))=CRHDPLST(CRHDN)
End DoDot:2
End DoDot:1
+18 FOR
if CRHDORI'<CRHDMAX
QUIT
SET CRHDN=$ORDER(CRHDTL(CRHDN),CRHDDIR)
if CRHDN=""
QUIT
Begin DoDot:1
+19 SET CRHDORI=CRHDORI+1
SET CRHDRTN(CRHDORI)=CRHDTL(CRHDN)
End DoDot:1
+20 QUIT
HOTPRVPT(CRHDRTN,CRHDTM,CRHDPRV) ;
+1 ;return list of patients from the HO team list provider
+2 KILL CRHDRTN
+3 NEW CRHDPLST,CRHDORI,CRHDMAX,CRHDP,CRHDTMPL,CRHDCT,CRHDI,CRHDN,CRHDNN,CRHDNNN
+4 SET CRHDORI=0
SET CRHDMAX=44
+5 DO HOPLIST^CRHD9(.CRHDPLST,CRHDTM)
+6 IF $DATA(CRHDPLST)
Begin DoDot:1
+7 SET CRHDN=0
SET CRHDCT=0
+8 FOR
SET CRHDN=$ORDER(CRHDPLST(CRHDN))
if 'CRHDN
QUIT
Begin DoDot:2
+9 SET CRHDP=$PIECE(CRHDPLST(CRHDN),"*",2)
+10 FOR CRHDI=2:1:$LENGTH(CRHDP,";")
IF +$PIECE(CRHDP,";",CRHDI)
Begin DoDot:3
+11 IF +CRHDPRV
IF +CRHDPRV=+$PIECE(CRHDP,";",CRHDI)
SET CRHDCT=CRHDCT+1
SET CRHDTMPL($PIECE($PIECE(CRHDP,";",CRHDI),"^",2),+$PIECE(CRHDP,";",CRHDI),CRHDCT)=$PIECE(CRHDPLST(CRHDN),"*",1)
QUIT
+12 IF 'CRHDPRV
SET CRHDCT=CRHDCT+1
SET CRHDTMPL($PIECE($PIECE(CRHDP,";",CRHDI),"^",2),+$PIECE(CRHDP,";",CRHDI),CRHDCT)=$PIECE(CRHDPLST(CRHDN),"*",1)
End DoDot:3
End DoDot:2
End DoDot:1
+13 IF $DATA(CRHDTMPL)
Begin DoDot:1
+14 SET CRHDN=""
+15 FOR
if CRHDORI'<CRHDMAX
QUIT
SET CRHDN=$ORDER(CRHDTMPL(CRHDN))
if CRHDN=""
QUIT
Begin DoDot:2
+16 SET CRHDNN=0
+17 FOR
SET CRHDNN=$ORDER(CRHDTMPL(CRHDN,CRHDNN))
if 'CRHDNN
QUIT
Begin DoDot:3
+18 SET CRHDNNN=0
+19 FOR
SET CRHDNNN=$ORDER(CRHDTMPL(CRHDN,CRHDNN,CRHDNNN))
if 'CRHDNNN
QUIT
Begin DoDot:4
+20 SET CRHDORI=CRHDORI+1
SET CRHDRTN(CRHDORI)=CRHDN_"^"_CRHDNN_"^"_CRHDTMPL(CRHDN,CRHDNN,CRHDNNN)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+21 QUIT
