BICMGR ;IHS/CMI/MWR - ADD/EDIT CASE MANAGER; MAY 10, 2010
;;8.5;IMMUNIZATION;;SEP 01,2011
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; CALLED BY OPTION: "BI CASE MANAGERS ADD/EDIT" TO ADD OR
;; DEACTIVATE CASE MANAGERS.
;
;
;----------
START ;EP
;---> DIE Add/Edit Case Managers.
D SETVARS^BIUTL5
N Y
F D Q:$G(Y)<0
.D TITLE^BIUTL5("ADD/EDIT CASE MANAGERS")
.D TEXT1
.D DIC^BIFMAN(9002084.01,"QEMAL",.Y," Select CASE MANAGER: ")
.Q:Y<0
.D DIE^BIFMAN(9002084.01,.02,+Y,.BIPOP)
.S:BIPOP Y=-1
Q
;
;
;----------
TEXT1 ;EP
;;This option allows you to add new Case Managers, so that they can
;;be selected when editing a patient's Case Data.
;;
;;You may also add a "DATE INACTIVATED" here for a Case Manager who
;;is no longer active in your program. ANY DATE in a Case Manager's
;;Date Inactivated field will prevent that Case Manager from being
;;selected when editing a patient's Case Data.
;;
;;Occasionally, you may want to RE-activate a Case Manager. You may
;;do this by deleting the date in the DATE INACTIVATED field (enter
;;@ at the DATE INACTIVATED prompt).
;;
;;
D PRINTX("TEXT1")
Q
;
;
;----------
TRANS ;EP
;---> Transfer one Case Manager's patients to another Case Manager.
;
D TITLE^BIUTL5("TRANSFER A CASE MANAGER'S PATIENTS")
D TEXT2
D DIC^BIFMAN(9002084.01,"QEMA",.Y," Select OLD CASE MANAGER: ")
Q:Y<0
S BICMGR=+Y
D DIC^BIFMAN(9002084.01,"QEMA",.Y," Select NEW CASE MANAGER: ")
Q:Y<0
S BICMGR1=+Y
W !!?3,"All patients currently assigned to: ",$$PERSON^BIUTL1(BICMGR)
W !?3,"will be reassigned to.............: ",$$PERSON^BIUTL1(BICMGR1)
;
W !!?3,"Do you wish to proceed?"
S DIR("?")=" Enter YES to swap Case Managers."
S DIR(0)="Y",DIR("A")=" Enter Yes or No"
D ^DIR W !
Q:$D(DIRUT)!('Y)
N BILOCK S BILOCK=0
S N=0,M=0
F S N=$O(^BIP("C",BICMGR,N)) Q:'N D
.N BIPOP S BIPOP=0
.D DIE^BIFMAN(9002084,".1////"_BICMGR1,N,.BIPOP,1)
.I BIPOP S BILOCK=1 Q
.S M=M+1
;
W !?3,M," patients transferred from ",$$PERSON^BIUTL1(BICMGR)
W " to ",$$PERSON^BIUTL1(BICMGR1),"."
;---> If some patients were locked, notify user.
D:BILOCK TEXT3
D DIRZ^BIUTL3()
D EXIT
Q
;
;
;----------
TEXT2 ;EP
;;The purpose of this utility is to aid in the transfer of all of one
;;Case Manager's patients to another Case Manager, such as when there
;;is a turnover in staff. The program will ask you for an "OLD" Case
;;Manager and then for a "NEW" Case Manager. All patients who were
;;previously assigned to the "OLD" Case Manager will be reassigned to
;;the "NEW" Case Manager.
;;
;;If the "NEW" Case Manager you are looking for cannot be selected,
;;that person must first be added to the file of Case Managers by
;;using the "Add/Edit Case Managers" option.
;;
D PRINTX("TEXT2")
Q
;
;
;----------
TEXT3 ;EP
;;
;;NOTE! One or more patients were being edited by another user during
;; this transfer. Those patients did not get reassigned.
;; This transfer should be run again later to pick up any
;; remaining patients.
D PRINTX("TEXT3",3)
Q
;
;
;----------
PRINTX(BILINL,BITAB) ;EP
Q:$G(BILINL)=""
N I,T,X S T="" S:'$D(BITAB) BITAB=5 F I=1:1:BITAB S T=T_" "
F I=1:1 S X=$T(@BILINL+I) Q:X'[";;" W !,T,$P(X,";;",2)
Q
;
;
;----------
EXIT ;EP
;---> End of job cleanup.
D KILLALL^BIUTL8()
Q
BICMGR ;IHS/CMI/MWR - ADD/EDIT CASE MANAGER; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;;SEP 01,2011
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; CALLED BY OPTION: "BI CASE MANAGERS ADD/EDIT" TO ADD OR
+4 ;; DEACTIVATE CASE MANAGERS.
+5 ;
+6 ;
+7 ;----------
START ;EP
+1 ;---> DIE Add/Edit Case Managers.
+2 DO SETVARS^BIUTL5
+3 NEW Y
+4 FOR
Begin DoDot:1
+5 DO TITLE^BIUTL5("ADD/EDIT CASE MANAGERS")
+6 DO TEXT1
+7 DO DIC^BIFMAN(9002084.01,"QEMAL",.Y," Select CASE MANAGER: ")
+8 IF Y<0
QUIT
+9 DO DIE^BIFMAN(9002084.01,.02,+Y,.BIPOP)
+10 IF BIPOP
SET Y=-1
End DoDot:1
IF $GET(Y)<0
QUIT
+11 QUIT
+12 ;
+13 ;
+14 ;----------
TEXT1 ;EP
+1 ;;This option allows you to add new Case Managers, so that they can
+2 ;;be selected when editing a patient's Case Data.
+3 ;;
+4 ;;You may also add a "DATE INACTIVATED" here for a Case Manager who
+5 ;;is no longer active in your program. ANY DATE in a Case Manager's
+6 ;;Date Inactivated field will prevent that Case Manager from being
+7 ;;selected when editing a patient's Case Data.
+8 ;;
+9 ;;Occasionally, you may want to RE-activate a Case Manager. You may
+10 ;;do this by deleting the date in the DATE INACTIVATED field (enter
+11 ;;@ at the DATE INACTIVATED prompt).
+12 ;;
+13 ;;
+14 DO PRINTX("TEXT1")
+15 QUIT
+16 ;
+17 ;
+18 ;----------
TRANS ;EP
+1 ;---> Transfer one Case Manager's patients to another Case Manager.
+2 ;
+3 DO TITLE^BIUTL5("TRANSFER A CASE MANAGER'S PATIENTS")
+4 DO TEXT2
+5 DO DIC^BIFMAN(9002084.01,"QEMA",.Y," Select OLD CASE MANAGER: ")
+6 IF Y<0
QUIT
+7 SET BICMGR=+Y
+8 DO DIC^BIFMAN(9002084.01,"QEMA",.Y," Select NEW CASE MANAGER: ")
+9 IF Y<0
QUIT
+10 SET BICMGR1=+Y
+11 WRITE !!?3,"All patients currently assigned to: ",$$PERSON^BIUTL1(BICMGR)
+12 WRITE !?3,"will be reassigned to.............: ",$$PERSON^BIUTL1(BICMGR1)
+13 ;
+14 WRITE !!?3,"Do you wish to proceed?"
+15 SET DIR("?")=" Enter YES to swap Case Managers."
+16 SET DIR(0)="Y"
SET DIR("A")=" Enter Yes or No"
+17 DO ^DIR
WRITE !
+18 IF $DATA(DIRUT)!('Y)
QUIT
+19 NEW BILOCK
SET BILOCK=0
+20 SET N=0
SET M=0
+21 FOR
SET N=$ORDER(^BIP("C",BICMGR,N))
IF 'N
QUIT
Begin DoDot:1
+22 NEW BIPOP
SET BIPOP=0
+23 DO DIE^BIFMAN(9002084,".1////"_BICMGR1,N,.BIPOP,1)
+24 IF BIPOP
SET BILOCK=1
QUIT
+25 SET M=M+1
End DoDot:1
+26 ;
+27 WRITE !?3,M," patients transferred from ",$$PERSON^BIUTL1(BICMGR)
+28 WRITE " to ",$$PERSON^BIUTL1(BICMGR1),"."
+29 ;---> If some patients were locked, notify user.
+30 IF BILOCK
DO TEXT3
+31 DO DIRZ^BIUTL3()
+32 DO EXIT
+33 QUIT
+34 ;
+35 ;
+36 ;----------
TEXT2 ;EP
+1 ;;The purpose of this utility is to aid in the transfer of all of one
+2 ;;Case Manager's patients to another Case Manager, such as when there
+3 ;;is a turnover in staff. The program will ask you for an "OLD" Case
+4 ;;Manager and then for a "NEW" Case Manager. All patients who were
+5 ;;previously assigned to the "OLD" Case Manager will be reassigned to
+6 ;;the "NEW" Case Manager.
+7 ;;
+8 ;;If the "NEW" Case Manager you are looking for cannot be selected,
+9 ;;that person must first be added to the file of Case Managers by
+10 ;;using the "Add/Edit Case Managers" option.
+11 ;;
+12 DO PRINTX("TEXT2")
+13 QUIT
+14 ;
+15 ;
+16 ;----------
TEXT3 ;EP
+1 ;;
+2 ;;NOTE! One or more patients were being edited by another user during
+3 ;; this transfer. Those patients did not get reassigned.
+4 ;; This transfer should be run again later to pick up any
+5 ;; remaining patients.
+6 DO PRINTX("TEXT3",3)
+7 QUIT
+8 ;
+9 ;
+10 ;----------
PRINTX(BILINL,BITAB) ;EP
+1 IF $GET(BILINL)=""
QUIT
+2 NEW I,T,X
SET T=""
IF '$DATA(BITAB)
SET BITAB=5
FOR I=1:1:BITAB
SET T=T_" "
+3 FOR I=1:1
SET X=$TEXT(@BILINL+I)
IF X'[";;"
QUIT
WRITE !,T,$PIECE(X,";;",2)
+4 QUIT
+5 ;
+6 ;
+7 ;----------
EXIT ;EP
+1 ;---> End of job cleanup.
+2 DO KILLALL^BIUTL8()
+3 QUIT
