WVCMGR ;HCIOFO/FT,JR - ADD/EDIT CASE MANAGER ;07/22/2016 14:35
;;1.0;WOMEN'S HEALTH;**24**;Sep 30, 1998;Build 582
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
;; CALLED BY OPTION: "WV ADD/EDIT CASE MANAGERS" TO ADD AND EDIT
;; CASE MANAGERS.
;
;---> DIE ADD/EDIT CASE MANAGERS LOOP.
D SETVARS^WVUTL5
N Y,WVDD,WVPER
D SETVARS
Q:'$G(WVDD)
F D Q:$G(Y)<0
.D TITLE^WVUTL5("ADD/EDIT "_$P(WVPER,U))
.S WVDICW="S WVY=Y N Y S Y=$P($G(^WV("_$P(WVDD,U)_",+WVY,0)),U,2) D DD^%DT W:$L(Y)>10 ?32,""DATE INACTIVATED: "",Y"
.D DIC^WVFMAN($P(WVDD,U),"QEMAL",.Y," Select "_$P(WVPER,U,2)_": ","","","","",WVDICW)
.K WVDICW Q:Y<0
.D DIE^WVFMAN($P(WVDD,U),$P(WVDD,U,2),+Y,.WVPOP)
.S:WVPOP Y=-1
;
EXIT ;EP
D KILLALL^WVUTL8
Q
;
SETVARS ;INITIALIZE VARIABLES USED IN THIS ROUTINE
;WVDD=PERSON FILE #^INACTIVATION DATE FIELD #^FILE 790 INDEX^FILE 790 FIELD
I $G(WVTYPE)="CM" S WVDD=790.01_U_.02_U_"C"_U_.1,WVPER="CASE MANAGERS"_U_"CASE MANAGER"
I $G(WVTYPE)="MCC" S WVDD=790.011_U_2_U_"D"_U_.29,WVPER="MATERNITY CARE COORDINATORS"_U_"MATERNITY CARE COORDINATOR"
Q
;
TRANS ;EP
;---> TRANSFER ONE CASE MANAGER'S PATIENTS TO ANOTHER CASE MANAGER.
;
D TRANS1
D EXIT
Q
;
TRANS1 ;EP
N WVDD,WVPER
D SETVARS
Q:'$G(WVDD)
D TITLE^WVUTL5("TRANSFER A "_$P(WVPER,U,2)_"'S PATIENTS")
D:$G(WVTYPE)="CM" TEXT1
D:$G(WVTYPE)="MCC" TEXT2
S WVJOPEN=1
S WVDICW="S WVY=Y N Y S Y=$P($G(^WV("_$P(WVDD,U)_",+WVY,0)),U,2) D DD^%DT W:$L(Y)>10 ?32,""DATE INACTIVATED: "",Y"
D DIC^WVFMAN($P(WVDD,U),"QEMA",.Y," Select OLD "_$P(WVPER,U,2)_": ","","","","",WVDICW)
K WVJOPEN,WVDICW
Q:Y<0
S WVCMGR=+Y
S WVDICW="S WVY=Y N Y S Y=$P($G(^WV("_$P(WVDD,U)_",+WVY,0)),U,2) D DD^%DT W:$L(Y)>10 ?32,""DATE INACTIVATED: "",Y"
S WVDICS="I $P($G(^WV("_$P(WVDD,U)_",+Y,0)),U,2)="""""
D DIC^WVFMAN($P(WVDD,U),"QEMA",.Y," Select NEW "_$P(WVPER,U,2)_": ","",WVDICS,"","",WVDICW)
K WVDICW,WVDICS Q:Y<0
S WVCMGR1=+Y
W !!?3,"All patients currently assigned to: ",$$PERSON^WVUTL1(WVCMGR)
W !?3,"will be reassigned to.............: ",$$PERSON^WVUTL1(WVCMGR1)
;
;---> YES/NO
W !!?3,"Do you wish to proceed?"
S DIR("?")=" Enter YES to swap "_$$TITLE^XLFSTR($P(WVPER,U))_"."
S DIR(0)="Y",DIR("A")=" Enter Yes or No"
D ^DIR W !
Q:$D(DIRUT)!('Y)
N M,N
S N=0,M=0
F S N=$O(^WV(790,$P(WVDD,U,3),WVCMGR,N)) Q:'N D
.D DIE^WVFMAN(790,$P(WVDD,U,4)_"////"_WVCMGR1,N,.WVPOP)
.Q:WVPOP S M=M+1
W !?3,M," patients transferred from ",$$PERSON^WVUTL1(WVCMGR)
W " to ",$$PERSON^WVUTL1(WVCMGR1),"." D DIRZ^WVUTL3
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 WVTAB=5,WVLINL="TEXT1" D PRINTX
Q
;
TEXT2 ;HELP TEXT
;;The purpose of this utility is to aid in the transfer of all of one
;;Maternity Care Coordinator's patients to another Maternity Care
;;Coordinator, such as when there is a turnover in staff.
;;The program will ask you for an "OLD" Maternity Care Coordinator
;;and then for a "NEW" Maternity Care Coordinator. All patients who
;;were previously assigned to the "OLD" Maternity Care Coordinator
;;will be reassigned to the "NEW" Maternity Care Coordinator.
;;
;;If the "NEW" Maternity Care Coordinator you are looking for cannot
;;be selected, that person must first be added to the file of
;;Maternity Care Coordinators by using the "Add/Edit Maternity Care
;;Coordinators" option.
;;
S WVTAB=5,WVLINL="TEXT2" D PRINTX
Q
;
PRINTX ;EP
N I,T,X S T=$$REPEAT^XLFSTR(" ",WVTAB)
F I=1:1 S X=$T(@WVLINL+I) Q:X'[";;" W !,T,$P(X,";;",2)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVCMGR 4123 printed Apr 09, 2024@21:50:30 Page 2
WVCMGR ;HCIOFO/FT,JR - ADD/EDIT CASE MANAGER ;07/22/2016 14:35
+1 ;;1.0;WOMEN'S HEALTH;**24**;Sep 30, 1998;Build 582
+2 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
+3 ;; CALLED BY OPTION: "WV ADD/EDIT CASE MANAGERS" TO ADD AND EDIT
+4 ;; CASE MANAGERS.
+5 ;
+6 ;---> DIE ADD/EDIT CASE MANAGERS LOOP.
+7 DO SETVARS^WVUTL5
+8 NEW Y,WVDD,WVPER
+9 DO SETVARS
+10 if '$GET(WVDD)
QUIT
+11 FOR
Begin DoDot:1
+12 DO TITLE^WVUTL5("ADD/EDIT "_$PIECE(WVPER,U))
+13 SET WVDICW="S WVY=Y N Y S Y=$P($G(^WV("_$PIECE(WVDD,U)_",+WVY,0)),U,2) D DD^%DT W:$L(Y)>10 ?32,""DATE INACTIVATED: "",Y"
+14 DO DIC^WVFMAN($PIECE(WVDD,U),"QEMAL",.Y," Select "_$PIECE(WVPER,U,2)_": ","","","","",WVDICW)
+15 KILL WVDICW
if Y<0
QUIT
+16 DO DIE^WVFMAN($PIECE(WVDD,U),$PIECE(WVDD,U,2),+Y,.WVPOP)
+17 if WVPOP
SET Y=-1
End DoDot:1
if $GET(Y)<0
QUIT
+18 ;
EXIT ;EP
+1 DO KILLALL^WVUTL8
+2 QUIT
+3 ;
SETVARS ;INITIALIZE VARIABLES USED IN THIS ROUTINE
+1 ;WVDD=PERSON FILE #^INACTIVATION DATE FIELD #^FILE 790 INDEX^FILE 790 FIELD
+2 IF $GET(WVTYPE)="CM"
SET WVDD=790.01_U_.02_U_"C"_U_.1
SET WVPER="CASE MANAGERS"_U_"CASE MANAGER"
+3 IF $GET(WVTYPE)="MCC"
SET WVDD=790.011_U_2_U_"D"_U_.29
SET WVPER="MATERNITY CARE COORDINATORS"_U_"MATERNITY CARE COORDINATOR"
+4 QUIT
+5 ;
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 NEW WVDD,WVPER
+2 DO SETVARS
+3 if '$GET(WVDD)
QUIT
+4 DO TITLE^WVUTL5("TRANSFER A "_$PIECE(WVPER,U,2)_"'S PATIENTS")
+5 if $GET(WVTYPE)="CM"
DO TEXT1
+6 if $GET(WVTYPE)="MCC"
DO TEXT2
+7 SET WVJOPEN=1
+8 SET WVDICW="S WVY=Y N Y S Y=$P($G(^WV("_$PIECE(WVDD,U)_",+WVY,0)),U,2) D DD^%DT W:$L(Y)>10 ?32,""DATE INACTIVATED: "",Y"
+9 DO DIC^WVFMAN($PIECE(WVDD,U),"QEMA",.Y," Select OLD "_$PIECE(WVPER,U,2)_": ","","","","",WVDICW)
+10 KILL WVJOPEN,WVDICW
+11 if Y<0
QUIT
+12 SET WVCMGR=+Y
+13 SET WVDICW="S WVY=Y N Y S Y=$P($G(^WV("_$PIECE(WVDD,U)_",+WVY,0)),U,2) D DD^%DT W:$L(Y)>10 ?32,""DATE INACTIVATED: "",Y"
+14 SET WVDICS="I $P($G(^WV("_$PIECE(WVDD,U)_",+Y,0)),U,2)="""""
+15 DO DIC^WVFMAN($PIECE(WVDD,U),"QEMA",.Y," Select NEW "_$PIECE(WVPER,U,2)_": ","",WVDICS,"","",WVDICW)
+16 KILL WVDICW,WVDICS
if Y<0
QUIT
+17 SET WVCMGR1=+Y
+18 WRITE !!?3,"All patients currently assigned to: ",$$PERSON^WVUTL1(WVCMGR)
+19 WRITE !?3,"will be reassigned to.............: ",$$PERSON^WVUTL1(WVCMGR1)
+20 ;
+21 ;---> YES/NO
+22 WRITE !!?3,"Do you wish to proceed?"
+23 SET DIR("?")=" Enter YES to swap "_$$TITLE^XLFSTR($PIECE(WVPER,U))_"."
+24 SET DIR(0)="Y"
SET DIR("A")=" Enter Yes or No"
+25 DO ^DIR
WRITE !
+26 if $DATA(DIRUT)!('Y)
QUIT
+27 NEW M,N
+28 SET N=0
SET M=0
+29 FOR
SET N=$ORDER(^WV(790,$PIECE(WVDD,U,3),WVCMGR,N))
if 'N
QUIT
Begin DoDot:1
+30 DO DIE^WVFMAN(790,$PIECE(WVDD,U,4)_"////"_WVCMGR1,N,.WVPOP)
+31 if WVPOP
QUIT
SET M=M+1
End DoDot:1
+32 WRITE !?3,M," patients transferred from ",$$PERSON^WVUTL1(WVCMGR)
+33 WRITE " to ",$$PERSON^WVUTL1(WVCMGR1),"."
DO DIRZ^WVUTL3
+34 QUIT
+35 ;
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 WVTAB=5
SET WVLINL="TEXT1"
DO PRINTX
+13 QUIT
+14 ;
TEXT2 ;HELP TEXT
+1 ;;The purpose of this utility is to aid in the transfer of all of one
+2 ;;Maternity Care Coordinator's patients to another Maternity Care
+3 ;;Coordinator, such as when there is a turnover in staff.
+4 ;;The program will ask you for an "OLD" Maternity Care Coordinator
+5 ;;and then for a "NEW" Maternity Care Coordinator. All patients who
+6 ;;were previously assigned to the "OLD" Maternity Care Coordinator
+7 ;;will be reassigned to the "NEW" Maternity Care Coordinator.
+8 ;;
+9 ;;If the "NEW" Maternity Care Coordinator you are looking for cannot
+10 ;;be selected, that person must first be added to the file of
+11 ;;Maternity Care Coordinators by using the "Add/Edit Maternity Care
+12 ;;Coordinators" option.
+13 ;;
+14 SET WVTAB=5
SET WVLINL="TEXT2"
DO PRINTX
+15 QUIT
+16 ;
PRINTX ;EP
+1 NEW I,T,X
SET T=$$REPEAT^XLFSTR(" ",WVTAB)
+2 FOR I=1:1
SET X=$TEXT(@WVLINL+I)
if X'[";;"
QUIT
WRITE !,T,$PIECE(X,";;",2)
+3 QUIT
