BWCMGR.m

BWCMGR ;IHS/ANMC/MWR - ADD/EDIT CASE MANAGER;15-Feb-2003 21:50;PLS

 ;;2.0;WOMEN'S HEALTH;**8**;MAY 16, 1996

 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *

 ;;  CALLED BY OPTION: "BW ADD/EDIT CASE MANAGERS" TO ADD AND EDIT

 ;;  CASE MANAGERS.

 ;

 ;---> DIE ADD/EDIT CASE MANAGERS LOOP.

 D SETVARS^BWUTL5

 N Y

 F  D  Q:$G(Y)<0

 .D TITLE^BWUTL5("ADD/EDIT CASE MANAGERS")

 .D DIC^BWFMAN(9002086.01,"QEMAL",.Y,"   Select CASE MANAGER: ")

 .Q:Y<0

 .D DIE^BWFMAN(9002086.01,.02,+Y,.BWPOP)

 .S:BWPOP Y=-1

 ;

EXIT ;EP

 D KILLALL^BWUTL8

 Q

 ;

TRANS ;EP

 ;---> TRANSFER ONE CASE MANAGER'S PATIENTS TO ANOTHER CASE MANAGER.

 ;

 D TRANS1

 D EXIT

 Q

 ;

TRANS1 ;EP

 D TITLE^BWUTL5("TRANSFER A CASE MANAGER'S PATIENTS")

 D TEXT1

 D DIC^BWFMAN(9002086.01,"QEMA",.Y,"   Select OLD CASE MANAGER: ")

 Q:Y<0

 S BWCMGR=+Y

 D DIC^BWFMAN(9002086.01,"QEMA",.Y,"   Select NEW CASE MANAGER: ")

 Q:Y<0

 S BWCMGR1=+Y

 W !!?3,"All patients currently assigned to: ",$$PERSON^BWUTL1(BWCMGR)

 W !?3,"will be reassigned to.............: ",$$PERSON^BWUTL1(BWCMGR1)

 ;

 ;---> YES/NO

 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)

 S N=0,M=0

 F  S N=$O(^BWP("C",BWCMGR,N)) Q:'N  D

 .D DIE^BWFMAN(9002086,".1////"_BWCMGR1,N,.BWPOP)

 .Q:BWPOP  S M=M+1

 W !?3,M," patients transferred from ",$$PERSON^BWUTL1(BWCMGR)

 W " to ",$$PERSON^BWUTL1(BWCMGR1),"."  D DIRZ^BWUTL3

 Q

 ;

TEXT1 ;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.

 ;;

 S BWTAB=5,BWLINL="TEXT1" D PRINTX

 Q

 ;

PRINTX ;EP

 N I,T,X S T="" F I=1:1:BWTAB S T=T_" "

 F I=1:1 S X=$T(@BWLINL+I) Q:X'[";;"  W !,T,$P(X,";;",2)

 Q

BWCMGR    ;IHS/ANMC/MWR - ADD/EDIT CASE MANAGER;15-Feb-2003 21:50;PLS

 +1       ;;2.0;WOMEN'S HEALTH;**8**;MAY 16, 1996

 +2       ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *

 +3       ;;  CALLED BY OPTION: "BW ADD/EDIT CASE MANAGERS" TO ADD AND EDIT

 +4       ;;  CASE MANAGERS.

 +5       ;

 +6       ;---> DIE ADD/EDIT CASE MANAGERS LOOP.

 +7        DO SETVARS^BWUTL5

 +8        NEW Y

 +9        FOR 

               Begin DoDot:1

 +10               DO TITLE^BWUTL5("ADD/EDIT CASE MANAGERS")

 +11               DO DIC^BWFMAN(9002086.01,"QEMAL",.Y,"   Select CASE MANAGER: ")

 +12               IF Y<0

                       QUIT 

 +13               DO DIE^BWFMAN(9002086.01,.02,+Y,.BWPOP)

 +14               IF BWPOP

                       SET Y=-1

               End DoDot:1

               IF $GET(Y)<0

                   QUIT 

 +15      ;

EXIT      ;EP

 +1        DO KILLALL^BWUTL8

 +2        QUIT 

 +3       ;

TRANS     ;EP

 +1       ;---> TRANSFER ONE CASE MANAGER'S PATIENTS TO ANOTHER CASE MANAGER.

 +2       ;

 +3        DO TRANS1

 +4        DO EXIT

 +5        QUIT 

 +6       ;

TRANS1    ;EP

 +1        DO TITLE^BWUTL5("TRANSFER A CASE MANAGER'S PATIENTS")

 +2        DO TEXT1

 +3        DO DIC^BWFMAN(9002086.01,"QEMA",.Y,"   Select OLD CASE MANAGER: ")

 +4        IF Y<0

               QUIT 

 +5        SET BWCMGR=+Y

 +6        DO DIC^BWFMAN(9002086.01,"QEMA",.Y,"   Select NEW CASE MANAGER: ")

 +7        IF Y<0

               QUIT 

 +8        SET BWCMGR1=+Y

 +9        WRITE !!?3,"All patients currently assigned to: ",$$PERSON^BWUTL1(BWCMGR)

 +10       WRITE !?3,"will be reassigned to.............: ",$$PERSON^BWUTL1(BWCMGR1)

 +11      ;

 +12      ;---> YES/NO

 +13       WRITE !!?3,"Do you wish to proceed?"

 +14       SET DIR("?")="     Enter YES to swap Case Managers."

 +15       SET DIR(0)="Y"

           SET DIR("A")="   Enter Yes or No"

 +16       DO ^DIR

           WRITE !

 +17       IF $DATA(DIRUT)!('Y)

               QUIT 

 +18       SET N=0

           SET M=0

 +19       FOR 

               SET N=$ORDER(^BWP("C",BWCMGR,N))

               IF 'N

                   QUIT 

               Begin DoDot:1

 +20               DO DIE^BWFMAN(9002086,".1////"_BWCMGR1,N,.BWPOP)

 +21               IF BWPOP

                       QUIT 

                   SET M=M+1

               End DoDot:1

 +22       WRITE !?3,M," patients transferred from ",$$PERSON^BWUTL1(BWCMGR)

 +23       WRITE " to ",$$PERSON^BWUTL1(BWCMGR1),"."

           DO DIRZ^BWUTL3

 +24       QUIT 

 +25      ;

TEXT1     ;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       SET BWTAB=5

           SET BWLINL="TEXT1"

           DO PRINTX

 +13       QUIT 

 +14      ;

PRINTX    ;EP

 +1        NEW I,T,X

           SET T=""

           FOR I=1:1:BWTAB

               SET T=T_" "

 +2        FOR I=1:1

               SET X=$TEXT(@BWLINL+I)

               IF X'[";;"

                   QUIT 

               WRITE !,T,$PIECE(X,";;",2)

 +3        QUIT