Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BWGETALL

BWGETALL.m

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