BWGETALL ;IHS/ANMC/MWR - AUTOLOAD FEMALE PATIENTS;15-Feb-2003 21:51;PLS
;;2.0;WOMEN'S HEALTH;**8**;MAY 16, 1996
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
;; AUTOMATICALLY LOADS WOMENS PATIENTS FROM THE MAIN PATIENT FILE,
;; LIMITED BY AGE AND CURRENT COMMUNITY.
;
D SETVARS^BWUTL5
D INTRO G:BWPOP EXIT
D SELECT G:BWPOP EXIT
D DEVICE G:BWPOP EXIT
D LOAD
;
EXIT ;EP
D KILLALL^BWUTL8
Q
;
;
INTRO ;EP
;---> INTRODUCTORY SCREENS.
S BWTITLE="AUTOLOAD PATIENTS"
D TITLE^BWUTL5(BWTITLE)
D TEXT1,DIRZ^BWUTL3
Q:BWPOP
D TITLE^BWUTL5(BWTITLE)
D TEXT2,DIRZ^BWUTL3
Q
;
SELECT ;EP
;---> SELECT AGE AND CURRENT COMMUNITY(S).
D TITLE^BWUTL5(BWTITLE)
;---> SELECT AGE.
K DIR
W !?5,"Select the age below which patients should NOT be added:"
S DIR("A")=" Enter AGE: ",DIR("B")=15
S DIR(0)="NOA^10:99:2" D HELP1
D ^DIR K DIR
I Y=-1!($D(DIRUT)) S BWPOP=1 Q
S BWAGE=+Y
;
;---> SELECT CURRENT COMMUNITY(S).
I $$AGENCY^BWUTL5(DUZ(2))'="i" S BWCC("ALL")="" Q ;VAMOD
D SELECT^BWSELECT("Current Community",9999999.05,"BWCC","","",.BWPOP)
Q
;
DEVICE ;EP
;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.
S ZTRTN="LOAD^BWGETALL"
S ZTSAVE("BWAGE")=""
;---> SAVE CURRENT COMMUNITY ARRAY.
I $D(BWCC) N N S N=0 F S N=$O(BWCC(N)) Q:N="" D
.S ZTSAVE("BWCC("""_N_""")")=""
D ZIS^BWUTL2(.BWPOP,1)
Q
;
LOAD ;EP
;---> AUTOLOAD OF PATIENTS
N BWCOUNT,BWERROR,N,X,Y D SETVARS^BWUTL5
D TOPHEAD^BWUTL7 S BWCONF=1
S BWTITLE="* AUTOLOAD OF WOMEN PATIENTS *"
D CENTERT^BWUTL5(.BWTITLE)
U IO
W:BWCRT @IOF D HEADER7^BWUTL7
S (BWCOUNT,N)=0
F S N=$O(^DPT(N)) Q:'N Q:BWPOP D
.S Y=^DPT(N,0)
.;---> QUIT IF NOT FEMALE.
.Q:$P(Y,U,2)'="F"
.;---> QUIT IF DECEASED OR LESS THAN BWAGE.
.Q:+$$AGE^BWUTL1(N)<BWAGE
.Q:$D(^BWP(N,0))
.;---> QUIT IF NOT SELECTING ALL CURRENT COMMUNITIES AND IF THIS IS
.;---> NOT ONE OF THE SELECTED.
.I '$D(BWCC("ALL")) S X=$$CURCOM^BWUTL1(N) Q:'X Q:'$D(BWCC(X))
.I $Y+8>IOSL D:BWCRT DIRZ^BWUTL3 Q:BWPOP D HEADER7^BWUTL7
.W !?3,$$NAME^BWUTL1(N),?30,$$HRCN^BWUTL1(N)
.W ?45,$$SLDT2^BWUTL5($$DOB^BWUTL1(N))
.D AUTOADD^BWPATE(N,DUZ(2),.BWERROR)
.I BWERROR<0 W ?60,"FAILED" Q
.S BWCOUNT=BWCOUNT+1 W ?60,"ADDED"
W !!?5,"TOTAL: ",BWCOUNT," PATIENT",$S(BWCOUNT=1:"",1:"S")
W " ADDED TO THE WOMEN'S HEALTH DATABASE.",!
D:BWCRT DIRZ^BWUTL3 W @IOF
D ^%ZISC
Q
;
;
TEXT1 ;EP
;;This utility will examine the main RPMS Patient Database for ALL
;;women over a given age and add them to the Women's Health Database.
;;
;;You will be asked to select a cutoff age (e.g., 40 and over), and you
;;will have an opportunity to select for specific Current Communities
;;(based on the RPMS Patient Registration Current Community field).
;;NOTE: Current Community for patients in RPMS Patient Registration
;;must be accurate in order for this utility to be effective.
;;(VA sites will not be prompted for Current Community.)
;;
;;Women already in the Women's Health Database will not be added twice.
;;Women who are deceased will not be added. Women added to the Women's
;;Health Database will be given Breast and Cervical Treatment Needs of
;;"Undetermined", with no due dates.
;;
;;This utility may be run at any time, as often as desired. It may be
;;useful to run it on a monthly basis in order to pick up new women who
;;are added to the RPMS Patient Database.
S BWTAB=5,BWLINL="TEXT1" D PRINTX
Q
;
;
TEXT2 ;EP
;;Before the program begins, you will be prompted for a "DEVICE:".
;;The name, chart#, and date of birth of each patient added to the
;;Women's Health Database will be displayed on the DEVICE.
;;This DEVICE may be a printer, or you may enter "HOME" to have the
;;information simply display on your screen.
;;
;;If the DEVICE you select is a printer, it may be preferable
;;to "queue" the job, in order to free up your terminal.
;;See your computer sitemanager for assistance with queuing jobs.
;;
;;WARNING: The first time this utility is run, it may add several
;;thousand patients to the Women's Health Database. It may take
;;several minutes or even hours to run, depending on the size of the
;;database and speed of the computer. Subsequent runs should be much
;;quicker.
;;
;;You may type "^" at anytime to quit before the program begins.
S BWTAB=5,BWLINL="TEXT2" D PRINTX
Q
;
HELP1 ;EP
;;Enter a two-digit number that will be the lowest age of patients
;;added to the Women's Health Database. For example, if you enter 15,
;;all women age 15 and older will be included, 14 and under will not.
S BWTAB=5,BWLINL="HELP1" D HELPTX
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
;
HELPTX ;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'[";;" S DIR("?",I)=T_$P(X,";;",2)
S DIR("?")=DIR("?",I-1) K DIR("?",I-1)
Q
BWGETALL ;IHS/ANMC/MWR - AUTOLOAD FEMALE PATIENTS;15-Feb-2003 21:51;PLS
+1 ;;2.0;WOMEN'S HEALTH;**8**;MAY 16, 1996
+2 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
+3 ;; AUTOMATICALLY LOADS WOMENS PATIENTS FROM THE MAIN PATIENT FILE,
+4 ;; LIMITED BY AGE AND CURRENT COMMUNITY.
+5 ;
+6 DO SETVARS^BWUTL5
+7 DO INTRO
IF BWPOP
GOTO EXIT
+8 DO SELECT
IF BWPOP
GOTO EXIT
+9 DO DEVICE
IF BWPOP
GOTO EXIT
+10 DO LOAD
+11 ;
EXIT ;EP
+1 DO KILLALL^BWUTL8
+2 QUIT
+3 ;
+4 ;
INTRO ;EP
+1 ;---> INTRODUCTORY SCREENS.
+2 SET BWTITLE="AUTOLOAD PATIENTS"
+3 DO TITLE^BWUTL5(BWTITLE)
+4 DO TEXT1
DO DIRZ^BWUTL3
+5 IF BWPOP
QUIT
+6 DO TITLE^BWUTL5(BWTITLE)
+7 DO TEXT2
DO DIRZ^BWUTL3
+8 QUIT
+9 ;
SELECT ;EP
+1 ;---> SELECT AGE AND CURRENT COMMUNITY(S).
+2 DO TITLE^BWUTL5(BWTITLE)
+3 ;---> SELECT AGE.
+4 KILL DIR
+5 WRITE !?5,"Select the age below which patients should NOT be added:"
+6 SET DIR("A")=" Enter AGE: "
SET DIR("B")=15
+7 SET DIR(0)="NOA^10:99:2"
DO HELP1
+8 DO ^DIR
KILL DIR
+9 IF Y=-1!($DATA(DIRUT))
SET BWPOP=1
QUIT
+10 SET BWAGE=+Y
+11 ;
+12 ;---> SELECT CURRENT COMMUNITY(S).
+13 ;VAMOD
IF $$AGENCY^BWUTL5(DUZ(2))'="i"
SET BWCC("ALL")=""
QUIT
+14 DO SELECT^BWSELECT("Current Community",9999999.05,"BWCC","","",.BWPOP)
+15 QUIT
+16 ;
DEVICE ;EP
+1 ;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.
+2 SET ZTRTN="LOAD^BWGETALL"
+3 SET ZTSAVE("BWAGE")=""
+4 ;---> SAVE CURRENT COMMUNITY ARRAY.
+5 IF $DATA(BWCC)
NEW N
SET N=0
FOR
SET N=$ORDER(BWCC(N))
IF N=""
QUIT
Begin DoDot:1
+6 SET ZTSAVE("BWCC("""_N_""")")=""
End DoDot:1
+7 DO ZIS^BWUTL2(.BWPOP,1)
+8 QUIT
+9 ;
LOAD ;EP
+1 ;---> AUTOLOAD OF PATIENTS
+2 NEW BWCOUNT,BWERROR,N,X,Y
DO SETVARS^BWUTL5
+3 DO TOPHEAD^BWUTL7
SET BWCONF=1
+4 SET BWTITLE="* AUTOLOAD OF WOMEN PATIENTS *"
+5 DO CENTERT^BWUTL5(.BWTITLE)
+6 USE IO
+7 IF BWCRT
WRITE @IOF
DO HEADER7^BWUTL7
+8 SET (BWCOUNT,N)=0
+9 FOR
SET N=$ORDER(^DPT(N))
IF 'N
QUIT
IF BWPOP
QUIT
Begin DoDot:1
+10 SET Y=^DPT(N,0)
+11 ;---> QUIT IF NOT FEMALE.
+12 IF $PIECE(Y,U,2)'="F"
QUIT
+13 ;---> QUIT IF DECEASED OR LESS THAN BWAGE.
+14 IF +$$AGE^BWUTL1(N)<BWAGE
QUIT
+15 IF $DATA(^BWP(N,0))
QUIT
+16 ;---> QUIT IF NOT SELECTING ALL CURRENT COMMUNITIES AND IF THIS IS
+17 ;---> NOT ONE OF THE SELECTED.
+18 IF '$DATA(BWCC("ALL"))
SET X=$$CURCOM^BWUTL1(N)
IF 'X
QUIT
IF '$DATA(BWCC(X))
QUIT
+19 IF $Y+8>IOSL
IF BWCRT
DO DIRZ^BWUTL3
IF BWPOP
QUIT
DO HEADER7^BWUTL7
+20 WRITE !?3,$$NAME^BWUTL1(N),?30,$$HRCN^BWUTL1(N)
+21 WRITE ?45,$$SLDT2^BWUTL5($$DOB^BWUTL1(N))
+22 DO AUTOADD^BWPATE(N,DUZ(2),.BWERROR)
+23 IF BWERROR<0
WRITE ?60,"FAILED"
QUIT
+24 SET BWCOUNT=BWCOUNT+1
WRITE ?60,"ADDED"
End DoDot:1
+25 WRITE !!?5,"TOTAL: ",BWCOUNT," PATIENT",$SELECT(BWCOUNT=1:"",1:"S")
+26 WRITE " ADDED TO THE WOMEN'S HEALTH DATABASE.",!
+27 IF BWCRT
DO DIRZ^BWUTL3
WRITE @IOF
+28 DO ^%ZISC
+29 QUIT
+30 ;
+31 ;
TEXT1 ;EP
+1 ;;This utility will examine the main RPMS Patient Database for ALL
+2 ;;women over a given age and add them to the Women's Health Database.
+3 ;;
+4 ;;You will be asked to select a cutoff age (e.g., 40 and over), and you
+5 ;;will have an opportunity to select for specific Current Communities
+6 ;;(based on the RPMS Patient Registration Current Community field).
+7 ;;NOTE: Current Community for patients in RPMS Patient Registration
+8 ;;must be accurate in order for this utility to be effective.
+9 ;;(VA sites will not be prompted for Current Community.)
+10 ;;
+11 ;;Women already in the Women's Health Database will not be added twice.
+12 ;;Women who are deceased will not be added. Women added to the Women's
+13 ;;Health Database will be given Breast and Cervical Treatment Needs of
+14 ;;"Undetermined", with no due dates.
+15 ;;
+16 ;;This utility may be run at any time, as often as desired. It may be
+17 ;;useful to run it on a monthly basis in order to pick up new women who
+18 ;;are added to the RPMS Patient Database.
+19 SET BWTAB=5
SET BWLINL="TEXT1"
DO PRINTX
+20 QUIT
+21 ;
+22 ;
TEXT2 ;EP
+1 ;;Before the program begins, you will be prompted for a "DEVICE:".
+2 ;;The name, chart#, and date of birth of each patient added to the
+3 ;;Women's Health Database will be displayed on the DEVICE.
+4 ;;This DEVICE may be a printer, or you may enter "HOME" to have the
+5 ;;information simply display on your screen.
+6 ;;
+7 ;;If the DEVICE you select is a printer, it may be preferable
+8 ;;to "queue" the job, in order to free up your terminal.
+9 ;;See your computer sitemanager for assistance with queuing jobs.
+10 ;;
+11 ;;WARNING: The first time this utility is run, it may add several
+12 ;;thousand patients to the Women's Health Database. It may take
+13 ;;several minutes or even hours to run, depending on the size of the
+14 ;;database and speed of the computer. Subsequent runs should be much
+15 ;;quicker.
+16 ;;
+17 ;;You may type "^" at anytime to quit before the program begins.
+18 SET BWTAB=5
SET BWLINL="TEXT2"
DO PRINTX
+19 QUIT
+20 ;
HELP1 ;EP
+1 ;;Enter a two-digit number that will be the lowest age of patients
+2 ;;added to the Women's Health Database. For example, if you enter 15,
+3 ;;all women age 15 and older will be included, 14 and under will not.
+4 SET BWTAB=5
SET BWLINL="HELP1"
DO HELPTX
+5 QUIT
+6 ;
+7 ;
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
+4 ;
HELPTX ;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
SET DIR("?",I)=T_$PIECE(X,";;",2)
+3 SET DIR("?")=DIR("?",I-1)
KILL DIR("?",I-1)
+4 QUIT
