WVGETALL ;HCIOFO/FT,JR-AUTOLOAD FEMALE PATIENTS ;4/7/00 15:59
;;1.0;WOMEN'S HEALTH;**3,7,10**;Sep 30, 1998
;; Original routine created by IHS/ANMC/MWR
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
;; AUTOMATICALLY LOADS WOMENS PATIENTS FROM THE MAIN PATIENT FILE,
;; LIMITED BY AGE AND CURRENT COMMUNITY.
;
EN ;
N WVPARM,WVEC
S WVPARM=$G(^WV(790.02,+$G(DUZ(2)),0)),WVEC=""
I WVPARM="" D CHECK^WVLOGO Q ;no site parameter entry
; Stop if no default case manager
I '$P(WVPARM,U,2) D NODCM^WVUTL9 Q
D SETVARS^WVUTL5
D INTRO G:WVPOP EXIT
D SELECT G:WVPOP EXIT
D EC^WVGETAL1 G:WVPOP EXIT
D DEVICE G:WVPOP EXIT
D LOAD
;
EXIT ;EP
D KILLALL^WVUTL8 K WVJSDT,WVJEDT,WVN,WVST
Q
;
;
INTRO ;EP
;---> INTRODUCTORY SCREENS.
S WVTITLE="AUTOLOAD PATIENTS"
D TITLE^WVUTL5(WVTITLE)
D TEXT1,DIRZ^WVUTL3
Q:WVPOP
D TITLE^WVUTL5(WVTITLE)
D TEXT2,DIRZ^WVUTL3
Q
;
SELECT ;EP
;---> SELECT AGE.
D TITLE^WVUTL5(WVTITLE)
;---> SELECT AGE.
K DIR
W !?5,"Select the age below which patients should NOT be added:"
S DIR("A")=" Enter AGE: ",DIR("B")=19
S DIR(0)="NOA^10:99" D HELP1
D ^DIR K DIR
I Y=-1!($D(DIRUT)) S WVPOP=1 Q
S WVAGE=+Y
W !!?5,"Define Active Patient for Patient file download."
W !?5,"If the patient has had no activity (visits or admissions) between"
W !?5,"the start and end dates you enter here, she will not be included"
W !?5,"in this Patient file download.",!
STD S DIR(0)="DAO^::E",DIR("A")=" Start Date of Patient Activity to Include: "
S Y=DT-30000,Y=$$DATECHK^WVEXPTRA(Y)
D DD^%DT S DIR("B")=Y
S DIR("?",1)=" If the patient has not had a Visit or Admission after this start date,"
S DIR("?",2)=" they will not be included in the auto-load."
S DIR("?")=" This date can be up to 3 years prior to todays date."
D ^DIR K DIR I Y'>0 W !!!! K WVJRDT S WVPOP=1 Q
S WVJSDT=Y
K S DIR(0)="DAO^::E",DIR("A")=" End Date of Patient Activity to Include: "
S DIR("?")=" "
S DIR("?",1)=" If the patient has not had a Visit or Admission before this date,"
S DIR("?",2)=" they will not be included in the auto-load."
S DIR("?",3)=" This date may be up to 3 years prior to todays date, but must be"
S DIR("?",4)=" after the start date."
S Y=DT D DD^%DT S DIR("B")=Y
D ^DIR K DIR I Y'>0 W !!!! K WVJSDT S WVPOP=1 Q
I Y<WVJSDT W !!!," END DATE MUST BE AFTER START DATE",!!! K WVJSDT G STD
S WVJEDT=$P(Y,".",1)_".9999"
Q
;
DEVICE ;EP
;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.
S ZTRTN="LOAD^WVGETALL"
S ZTSAVE("WVAGE")="",ZTSAVE("WVJSDT")="",ZTSAVE("WVJEDT")=""
S ZTSAVE("WVEC(")=""
D ZIS^WVUTL2(.WVPOP,1)
Q
;
LOAD ;EP
;---> AUTOLOAD OF PATIENTS
N WVCOUNT,WVERROR,N,X,Y D SETVARS^WVUTL5
D TOPHEAD^WVUTL7 S WVCONF=1
S WVTITLE="* AUTOLOAD OF WOMEN PATIENTS *"
D CENTERT^WVUTL5(.WVTITLE)
U IO
W:$Y>0 @IOF D HEADER7^WVUTL7
S (WVCOUNT,N)=0
S WVN=0 F S WVN=$O(^DPT("ASX","F",WVN)) Q:'WVN Q:WVPOP D
.S Y=^DPT(WVN,0)
.;---> QUIT IF NOT FEMALE.
.Q:$P(Y,U,2)'="F"
.;---> QUIT IF DECEASED OR LESS THAN WVAGE.
.Q:+$$AGE^WVUTL1(WVN)<WVAGE
.Q:$D(^WV(790,WVN,0))
.; Quit if patient not a veteran or doesn't have selected eligibility
.; code
.Q:'$$VECCHK^WVGETAL1(WVN)
.;Q:$$GET1^DIQ(2,WVN,1901,"I")'="Y"
.;Quit if not active patient
.Q:$$HOS(WVN)<1
.I $Y+5>IOSL D:WVCRT DIRZ^WVUTL3 Q:WVPOP D HEADER7^WVUTL7
.W !?3,$$NAME^WVUTL1(WVN),?30,$$SSN^WVUTL1(WVN)
.W ?45,$$SLDT2^WVUTL5($$DOB^WVUTL1(WVN))
.D AUTOADD^WVPATE(WVN,DUZ(2),.WVERROR)
.I WVERROR<0 W ?60,"FAILED" Q
.S WVCOUNT=WVCOUNT+1 W ?60,"ADDED" ;,?70,WVN
.W !?3,"Age: "_$$AGE^WVUTL9(WVN)_" / Veteran: "_$$VET^WVUTL1A(WVN)_" / Elig Code: "_$P($$ELIG^WVUTL9(WVN),U,2),!
W !!?5,"TOTAL: ",WVCOUNT," PATIENT",$S(WVCOUNT=1:"",1:"S")
W " ADDED TO THE WOMEN'S HEALTH DATABASE.",!
I WVCRT&('$D(IO("S"))) D DIRZ^WVUTL3 W @IOF
K TEST1,TEST2 D ^%ZISC
Q
;
;
TEXT1 ;EP
;;This utility will examine the VISTA Patient file (#2) for ALL
;;WOMEN VETERANS or WOMEN patients with an ELIGIBILITY CODE you
;;select over a given age who were seen in the date range selected,
;;and add them to the Women's Health Database.
;;
;;You will be asked to select a cutoff age (e.g., 40 and over),
;;Start and End Activity dates and Eligibility Code(s).
;;Patients not having a visit or admission between these dates
;;will not be added to the file. These dates can be no more
;;than 3 years prior to today's date.
;;
;;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 Patient Database.
S WVTAB=5,WVLINL="TEXT1" D PRINTX
Q
;
;
TEXT2 ;EP
;;Before the program begins, you will be prompted for a "DEVICE:".
;;The name, social security number, 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 WVTAB=5,WVLINL="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 WVTAB=5,WVLINL="HELP1" D HELPTX
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
;
HELPTX ;EP
N I,T,X S T=$$REPEAT^XLFSTR(" ",WVTAB)
F I=1:1 S X=$T(@WVLINL+I) Q:X'[";;" S DIR("?",I)=T_$P(X,";;",2)
S DIR("?")=DIR("?",I-1) K DIR("?",I-1)
Q
HOS(WVN) ;Comes here to determine if visit/adm. is current
;WVN=DFN, WVJSDT=Selected earliest date for consideration.
S WVST="ADFN"_WVN
S TEST1=$O(^DGPM(WVST,WVJSDT)) I TEST1>WVJSDT I TEST1<WVJEDT Q 1
S TEST2=$O(^SCE("ADFN",WVN,WVJSDT)) I TEST2>WVJSDT I TEST2<WVJEDT Q 1
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVGETALL 6813 printed Nov 22, 2024@17:56:50 Page 2
WVGETALL ;HCIOFO/FT,JR-AUTOLOAD FEMALE PATIENTS ;4/7/00 15:59
+1 ;;1.0;WOMEN'S HEALTH;**3,7,10**;Sep 30, 1998
+2 ;; Original routine created by IHS/ANMC/MWR
+3 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
+4 ;; AUTOMATICALLY LOADS WOMENS PATIENTS FROM THE MAIN PATIENT FILE,
+5 ;; LIMITED BY AGE AND CURRENT COMMUNITY.
+6 ;
EN ;
+1 NEW WVPARM,WVEC
+2 SET WVPARM=$GET(^WV(790.02,+$GET(DUZ(2)),0))
SET WVEC=""
+3 ;no site parameter entry
IF WVPARM=""
DO CHECK^WVLOGO
QUIT
+4 ; Stop if no default case manager
+5 IF '$PIECE(WVPARM,U,2)
DO NODCM^WVUTL9
QUIT
+6 DO SETVARS^WVUTL5
+7 DO INTRO
if WVPOP
GOTO EXIT
+8 DO SELECT
if WVPOP
GOTO EXIT
+9 DO EC^WVGETAL1
if WVPOP
GOTO EXIT
+10 DO DEVICE
if WVPOP
GOTO EXIT
+11 DO LOAD
+12 ;
EXIT ;EP
+1 DO KILLALL^WVUTL8
KILL WVJSDT,WVJEDT,WVN,WVST
+2 QUIT
+3 ;
+4 ;
INTRO ;EP
+1 ;---> INTRODUCTORY SCREENS.
+2 SET WVTITLE="AUTOLOAD PATIENTS"
+3 DO TITLE^WVUTL5(WVTITLE)
+4 DO TEXT1
DO DIRZ^WVUTL3
+5 if WVPOP
QUIT
+6 DO TITLE^WVUTL5(WVTITLE)
+7 DO TEXT2
DO DIRZ^WVUTL3
+8 QUIT
+9 ;
SELECT ;EP
+1 ;---> SELECT AGE.
+2 DO TITLE^WVUTL5(WVTITLE)
+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")=19
+7 SET DIR(0)="NOA^10:99"
DO HELP1
+8 DO ^DIR
KILL DIR
+9 IF Y=-1!($DATA(DIRUT))
SET WVPOP=1
QUIT
+10 SET WVAGE=+Y
+11 WRITE !!?5,"Define Active Patient for Patient file download."
+12 WRITE !?5,"If the patient has had no activity (visits or admissions) between"
+13 WRITE !?5,"the start and end dates you enter here, she will not be included"
+14 WRITE !?5,"in this Patient file download.",!
STD SET DIR(0)="DAO^::E"
SET DIR("A")=" Start Date of Patient Activity to Include: "
+1 SET Y=DT-30000
SET Y=$$DATECHK^WVEXPTRA(Y)
+2 DO DD^%DT
SET DIR("B")=Y
+3 SET DIR("?",1)=" If the patient has not had a Visit or Admission after this start date,"
+4 SET DIR("?",2)=" they will not be included in the auto-load."
+5 SET DIR("?")=" This date can be up to 3 years prior to todays date."
+6 DO ^DIR
KILL DIR
IF Y'>0
WRITE !!!!
KILL WVJRDT
SET WVPOP=1
QUIT
+7 SET WVJSDT=Y
K SET DIR(0)="DAO^::E"
SET DIR("A")=" End Date of Patient Activity to Include: "
+1 SET DIR("?")=" "
+2 SET DIR("?",1)=" If the patient has not had a Visit or Admission before this date,"
+3 SET DIR("?",2)=" they will not be included in the auto-load."
+4 SET DIR("?",3)=" This date may be up to 3 years prior to todays date, but must be"
+5 SET DIR("?",4)=" after the start date."
+6 SET Y=DT
DO DD^%DT
SET DIR("B")=Y
+7 DO ^DIR
KILL DIR
IF Y'>0
WRITE !!!!
KILL WVJSDT
SET WVPOP=1
QUIT
+8 IF Y<WVJSDT
WRITE !!!," END DATE MUST BE AFTER START DATE",!!!
KILL WVJSDT
GOTO STD
+9 SET WVJEDT=$PIECE(Y,".",1)_".9999"
+10 QUIT
+11 ;
DEVICE ;EP
+1 ;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.
+2 SET ZTRTN="LOAD^WVGETALL"
+3 SET ZTSAVE("WVAGE")=""
SET ZTSAVE("WVJSDT")=""
SET ZTSAVE("WVJEDT")=""
+4 SET ZTSAVE("WVEC(")=""
+5 DO ZIS^WVUTL2(.WVPOP,1)
+6 QUIT
+7 ;
LOAD ;EP
+1 ;---> AUTOLOAD OF PATIENTS
+2 NEW WVCOUNT,WVERROR,N,X,Y
DO SETVARS^WVUTL5
+3 DO TOPHEAD^WVUTL7
SET WVCONF=1
+4 SET WVTITLE="* AUTOLOAD OF WOMEN PATIENTS *"
+5 DO CENTERT^WVUTL5(.WVTITLE)
+6 USE IO
+7 if $Y>0
WRITE @IOF
DO HEADER7^WVUTL7
+8 SET (WVCOUNT,N)=0
+9 SET WVN=0
FOR
SET WVN=$ORDER(^DPT("ASX","F",WVN))
if 'WVN
QUIT
if WVPOP
QUIT
Begin DoDot:1
+10 SET Y=^DPT(WVN,0)
+11 ;---> QUIT IF NOT FEMALE.
+12 if $PIECE(Y,U,2)'="F"
QUIT
+13 ;---> QUIT IF DECEASED OR LESS THAN WVAGE.
+14 if +$$AGE^WVUTL1(WVN)<WVAGE
QUIT
+15 if $DATA(^WV(790,WVN,0))
QUIT
+16 ; Quit if patient not a veteran or doesn't have selected eligibility
+17 ; code
+18 if '$$VECCHK^WVGETAL1(WVN)
QUIT
+19 ;Q:$$GET1^DIQ(2,WVN,1901,"I")'="Y"
+20 ;Quit if not active patient
+21 if $$HOS(WVN)<1
QUIT
+22 IF $Y+5>IOSL
if WVCRT
DO DIRZ^WVUTL3
if WVPOP
QUIT
DO HEADER7^WVUTL7
+23 WRITE !?3,$$NAME^WVUTL1(WVN),?30,$$SSN^WVUTL1(WVN)
+24 WRITE ?45,$$SLDT2^WVUTL5($$DOB^WVUTL1(WVN))
+25 DO AUTOADD^WVPATE(WVN,DUZ(2),.WVERROR)
+26 IF WVERROR<0
WRITE ?60,"FAILED"
QUIT
+27 ;,?70,WVN
SET WVCOUNT=WVCOUNT+1
WRITE ?60,"ADDED"
+28 WRITE !?3,"Age: "_$$AGE^WVUTL9(WVN)_" / Veteran: "_$$VET^WVUTL1A(WVN)_" / Elig Code: "_$PIECE($$ELIG^WVUTL9(WVN),U,2),!
End DoDot:1
+29 WRITE !!?5,"TOTAL: ",WVCOUNT," PATIENT",$SELECT(WVCOUNT=1:"",1:"S")
+30 WRITE " ADDED TO THE WOMEN'S HEALTH DATABASE.",!
+31 IF WVCRT&('$DATA(IO("S")))
DO DIRZ^WVUTL3
WRITE @IOF
+32 KILL TEST1,TEST2
DO ^%ZISC
+33 QUIT
+34 ;
+35 ;
TEXT1 ;EP
+1 ;;This utility will examine the VISTA Patient file (#2) for ALL
+2 ;;WOMEN VETERANS or WOMEN patients with an ELIGIBILITY CODE you
+3 ;;select over a given age who were seen in the date range selected,
+4 ;;and add them to the Women's Health Database.
+5 ;;
+6 ;;You will be asked to select a cutoff age (e.g., 40 and over),
+7 ;;Start and End Activity dates and Eligibility Code(s).
+8 ;;Patients not having a visit or admission between these dates
+9 ;;will not be added to the file. These dates can be no more
+10 ;;than 3 years prior to today's date.
+11 ;;
+12 ;;Women already in the Women's Health Database will not be added twice.
+13 ;;Women who are deceased will not be added. Women added to the Women's
+14 ;;Health Database will be given Breast and Cervical Treatment Needs of
+15 ;;"Undetermined", with no due dates.
+16 ;;
+17 ;;This utility may be run at any time, as often as desired. It may be
+18 ;;useful to run it on a monthly basis in order to pick up new women who
+19 ;;are added to the Patient Database.
+20 SET WVTAB=5
SET WVLINL="TEXT1"
DO PRINTX
+21 QUIT
+22 ;
+23 ;
TEXT2 ;EP
+1 ;;Before the program begins, you will be prompted for a "DEVICE:".
+2 ;;The name, social security number, and date of birth of each
+3 ;;patient added to the Women's Health Database will be displayed
+4 ;;on the DEVICE.
+5 ;;This DEVICE may be a printer, or you may enter "HOME" to have the
+6 ;;information simply display on your screen.
+7 ;;
+8 ;;If the DEVICE you select is a printer, it may be preferable
+9 ;;to "queue" the job, in order to free up your terminal.
+10 ;;See your computer sitemanager for assistance with queuing jobs.
+11 ;;
+12 ;;WARNING: The first time this utility is run, it may add several
+13 ;;thousand patients to the Women's Health Database. It may take
+14 ;;several minutes or even hours to run, depending on the size of the
+15 ;;database and speed of the computer. Subsequent runs should be much
+16 ;;quicker.
+17 ;;
+18 ;;You may type "^" at anytime to quit before the program begins.
+19 SET WVTAB=5
SET WVLINL="TEXT2"
DO PRINTX
+20 QUIT
+21 ;
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 WVTAB=5
SET WVLINL="HELP1"
DO HELPTX
+5 QUIT
+6 ;
+7 ;
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
+4 ;
HELPTX ;EP
+1 NEW I,T,X
SET T=$$REPEAT^XLFSTR(" ",WVTAB)
+2 FOR I=1:1
SET X=$TEXT(@WVLINL+I)
if X'[";;"
QUIT
SET DIR("?",I)=T_$PIECE(X,";;",2)
+3 SET DIR("?")=DIR("?",I-1)
KILL DIR("?",I-1)
+4 QUIT
HOS(WVN) ;Comes here to determine if visit/adm. is current
+1 ;WVN=DFN, WVJSDT=Selected earliest date for consideration.
+2 SET WVST="ADFN"_WVN
+3 SET TEST1=$ORDER(^DGPM(WVST,WVJSDT))
IF TEST1>WVJSDT
IF TEST1<WVJEDT
QUIT 1
+4 SET TEST2=$ORDER(^SCE("ADFN",WVN,WVJSDT))
IF TEST2>WVJSDT
IF TEST2<WVJEDT
QUIT 1
+5 QUIT 0
