BICMGR.m

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