source: WorldVistAEHR/trunk/r/WOMENS_HEALTH-WV/WVCMGR.m

Last change on this file was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.6 KB
Line 
1WVCMGR ;HCIOFO/FT,JR IHS/ANMC/MWR - ADD/EDIT CASE MANAGER; ;8/10/98 15:08
2 ;;1.0;WOMEN'S HEALTH;;Sep 30, 1998
3 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
4 ;; CALLED BY OPTION: "WV ADD/EDIT CASE MANAGERS" TO ADD AND EDIT
5 ;; CASE MANAGERS.
6 ;
7 ;---> DIE ADD/EDIT CASE MANAGERS LOOP.
8 D SETVARS^WVUTL5
9 N Y
10 F D Q:$G(Y)<0
11 .D TITLE^WVUTL5("ADD/EDIT CASE MANAGERS")
12 .S WVDICW="S WVY=Y N Y S Y=$P($G(^WV(790.01,+WVY,0)),U,2) D DD^%DT W:$L(Y)>10 ?32,""DATE INACTIVATED: "",Y"
13 .D DIC^WVFMAN(790.01,"QEMAL",.Y," Select CASE MANAGER: ","","","","",WVDICW)
14 .K WVDICW Q:Y<0
15 .D DIE^WVFMAN(790.01,.02,+Y,.WVPOP)
16 .S:WVPOP Y=-1
17 ;
18EXIT ;EP
19 D KILLALL^WVUTL8
20 Q
21 ;
22TRANS ;EP
23 ;---> TRANSFER ONE CASE MANAGER'S PATIENTS TO ANOTHER CASE MANAGER.
24 ;
25 D TRANS1
26 D EXIT
27 Q
28 ;
29TRANS1 ;EP
30 D TITLE^WVUTL5("TRANSFER A CASE MANAGER'S PATIENTS")
31 D TEXT1 S WVJOPEN=1
32 S WVDICW="S WVY=Y N Y S Y=$P($G(^WV(790.01,+WVY,0)),U,2) D DD^%DT W:$L(Y)>10 ?32,""DATE INACTIVATED: "",Y"
33 D DIC^WVFMAN(790.01,"QEMA",.Y," Select OLD CASE MANAGER: ","","","","",WVDICW)
34 K WVJOPEN,WVDICW
35 Q:Y<0
36 S WVCMGR=+Y
37 S WVDICW="S WVY=Y N Y S Y=$P($G(^WV(790.01,+WVY,0)),U,2) D DD^%DT W:$L(Y)>10 ?32,""DATE INACTIVATED: "",Y"
38 D DIC^WVFMAN(790.01,"QEMA",.Y," Select NEW CASE MANAGER: ","","","","",WVDICW)
39 K WVDICW Q:Y<0
40 S WVCMGR1=+Y
41 W !!?3,"All patients currently assigned to: ",$$PERSON^WVUTL1(WVCMGR)
42 W !?3,"will be reassigned to.............: ",$$PERSON^WVUTL1(WVCMGR1)
43 ;
44 ;---> YES/NO
45 W !!?3,"Do you wish to proceed?"
46 S DIR("?")=" Enter YES to swap Case Managers."
47 S DIR(0)="Y",DIR("A")=" Enter Yes or No"
48 D ^DIR W !
49 Q:$D(DIRUT)!('Y)
50 N M,N
51 S N=0,M=0
52 F S N=$O(^WV(790,"C",WVCMGR,N)) Q:'N D
53 .D DIE^WVFMAN(790,".1////"_WVCMGR1,N,.WVPOP)
54 .Q:WVPOP S M=M+1
55 W !?3,M," patients transferred from ",$$PERSON^WVUTL1(WVCMGR)
56 W " to ",$$PERSON^WVUTL1(WVCMGR1),"." D DIRZ^WVUTL3
57 Q
58 ;
59TEXT1 ;EP
60 ;;The purpose of this utility is to aid in the transfer of all of one
61 ;;Case Manager's patients to another Case Manager, such as when there
62 ;;is a turnover in staff. The program will ask you for an "OLD" Case
63 ;;Manager and then for a "NEW" Case Manager. All patients who were
64 ;;previously assigned to the "OLD" Case Manager will be reassigned to
65 ;;the "NEW" Case Manager.
66 ;;
67 ;;If the "NEW" Case Manager you are looking for cannot be selected,
68 ;;that person must first be added to the file of Case Managers by
69 ;;using the "Add/Edit Case Managers" option.
70 ;;
71 S WVTAB=5,WVLINL="TEXT1" D PRINTX
72 Q
73 ;
74PRINTX ;EP
75 N I,T,X S T=$$REPEAT^XLFSTR(" ",WVTAB)
76 F I=1:1 S X=$T(@WVLINL+I) Q:X'[";;" W !,T,$P(X,";;",2)
77 Q
Note: See TracBrowser for help on using the repository browser.