source: FOIAVistA/trunk/r/WOMENS_HEALTH-WV/WVUTL8.m@ 914

WVUTL8 ;HCIOFO/FT,JR IHS/ANMC/MWR - UTIL: PATLKUP, SELECT, KILLALL; ;12/15/98  16:43
 ;;1.0;WOMEN'S HEALTH;**3**;Sep 30, 1998
 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
 ;;  UTILITY: PATIENT LOOKUP, SELECT FOR REPORT, KILLALL.
 ;
PATLKUP(Y,WVADD,DUZ2,WVPOP) ;EP
 ;---> WV PATIENT LOOKUP.
 ;---> PARAMETERS:
 ;     1 - Y             (RETURNED) PATIENT DFN OR -1 IF FAILED.
 ;     2 - WVADD         (OPTIONAL) EQUALS "ADD" IF ADD CAPABILITY
 ;     3 - DUZ2=DUZ(2)   (OPTIONAL) IF NOT SET, WILL=ENVIROMENTAL DUZ(2)
 ;     4 - WVPOP         (RETURNED) WVPOP=1 IF DTOUT OR DUOUT
 ;
 ;---> EXAMPLE: D PATLKUP^WVUTL8(.Y)
 ;              D PATLKUP^WVUTL8(.Y,"ADD") - MAY ADD PATIENT TO WH.
 ;
 N DFN,DIC,X
PATLKUP1 ;---> RETURN HERE IF LOOKUP FAILED FOR SEX OR AGE.
 ;---> SET VARIABLES: Y=DFN,WVPOP=1 FOR QUIT.
 S WVPOP=0 D SETVARS^WVUTL5
 S:$G(DUZ2)]"" DUZ(2)=DUZ2
 S DIC="^DPT(",DIC(0)="AEMQ",DIC("S")="I $P(^(0),U,2)=""F"""
 D ^DIC
 Q:$D(DUOUT)!($D(DTOUT))
 Q:Y<0
 S (DFN,Y)=+Y
 ;---> IF PATIENT ALREADY EXISTS IN WV PATIENT FILE, QUIT.
 Q:$D(^WV(790,DFN,0))
 ;
 ;---> IF PATIENT IS NOT FEMALE, PROMPT USER.
 I '$$SEX^WVUTL1(DFN) D  G PATLKUP1
 .W !!?3,$$NAME^WVUTL1(DFN)," is not female." D DIRZ^WVUTL3
 ;
 ;---> QUIT IF NO ADD ("LAYGO") CAPABILITY.
 I $G(WVADD)'="ADD" D  G PATLKUP1
 .W !!?3,$$NAME^WVUTL1(DFN)
 .W " is not currently in the Women's Health database." D DIRZ^WVUTL3
 ;
 ;---> ASK TO ADD AS A NEW PATIENT.
 W !!?3,$$NAME^WVUTL1(DFN)
 W " ("_$$AGE^WVUTL1(DFN)_")" ;show patient's age
 W !?3,"is not currently in the Women's Health database."
 W !?3,"Do you wish to add her to the Women's Health Database?"
 S DIR("?",1)="     Enter YES to ADD this patient to the Women's Health"
 S DIR("?",1)=DIR("?",1)_" database."
 S DIR("?")="     Enter NO to quit without adding her to the database."
 S DIR(0)="Y",DIR("A")="   Enter Yes or No"
 D ^DIR W !
 I $D(DIRUT) S Y=-1 Q
 G:Y=0 PATLKUP1
 D AUTOADD^WVPATE(DFN,DUZ(2),.Y,1)
 Q
 ;
KGBL(GBL) ;EP
 ;---> KILL A GLOBAL.  GBL SHOULD INCLUDE THE LEADING "^".
 S:GBL["(" GBL=$P(GBL,"(")
 F  S GBL=$Q(@GBL) Q:GBL=""  K @GBL
 Q
 ;
ZGBL(GBL) ;EP
 ;---> ZERO OUT (DELETE ALL DATA) IN A FILEMAN FILE.
 ;---> GBL SHOULD INCLUDE THE LEADING "^".
 N N,X
 S:GBL["(" GBL=$P(GBL,"(")
 Q:'$D(@(GBL_"(0)"))
 S N=0,X=$P(@(GBL_"(0)"),U,1,2)
 F  S N=$O(@(GBL_"("""_N_""")")) Q:N=""  K @(GBL_"("""_N_""")")
 S @(GBL_"(0)")=X
 Q
 ;
KILLALL ;EP
 ;---> CLEAN UP VARIABLES.
 ;---> MSM
 ;S X="WV" F  S X=$O(@X) Q:$E(X,1,2)'="WV"  K @X
 ;S X="DI" F  S X=$O(@X) Q:$E(X,1,2)'="WV"  K @X
 ;---> DSM
 ;S X="WV" F  S X=$ZSORT(@X) Q:$E(X,1,2)'="WV"  K @X
 ;S X="DI" F  S X=$ZSORT(@X) Q:$E(X,1,2)'="WV"  K @X
 ;
 ;---> REPLACE KILLS BELOW WITH $O COMMANDS ABOVE WHEN AVAILABLE.
 K WV,WV0,WV1,WV1DX,WV2,WV2DX,WVA,WVABBV,WVABBVS,WVACC
 K WVACCN,WVACCP,WVADD,WVAGE,WVAGENCY,WVAGRG,WVAGRP,WVAR,WVAREA
 K WVARR,WVARR1,WVASKTIM,WVATT,WVB,WVBDF,WVBEGDF,WVBEGDT
 K WVBEGDT1,WVBNEED,WVC,WVC0,WVCAPT,WVCBEDA,WVCC,WVCDC,WVCDCV,WVCHAGE
 K WVCHG,WVCHRT,WVCHSSN,WVCMGR,WVCMGR1,WVCNEED,WVCODE,WVCOLPS,WVCONF
 K WVCONFF,WVCOUNT,WVCRT,WVCUR,WVD,WVDA,WVDATE,WVDATE1,WVDD,WVDDATE
 K WVDEF,WVDFLT,WVDFN,WVDIAG,WVDR,WVDT,WVDUZ0,WVDUZ2,WVDX
 K WVE,WVEDC,WVEDCL,WVEDF,WVENDDF,WVENDDT,WVENDDT1,WVENDSAM,WVENDT
 K WVERR,WVERROR,WVERRORS,WVFAC,WVFACIL,WVFILE,WVFLNM,WVGBL
 K WVGBLN,WVHEADER,WVHCF,WVHFS,WVHLOC,WVHRCN,WVI,WVICD,WVIEN,WVION
 K WVITEM,WVITEMS,WVKDT,WVLDAT,WVLFRT,WVLINE,WVLINL,WVLOC,WVLOGO
 K WVLOOP,WVLPRG,WVM,WVMABN,WVMAM,WVMAMDT,WVMATCH,WVMENUT,WVMES,WVN
 K WVNAMAGE,WVNAME,WVNEW,WVNN,WVNODE,WVNOFAC,WVNOFOL,WVNOMAT,WVNORM
 K WVNOW,WVOFAC,WVOLD,WVOLD2,WVOUT,WVPABN,WVPAGE,WVPAP,WVPAPDA,WVPAPDT
 K WVPAPRG,WVPAPRG1,WVPAPS,WVPATH,WVPATS,WVPC,WVPCCN,WVPCCP,WVPCD,WVPCDL
 K WVPCDN,WVPCDS,WVPCDT,WVPDATE,WVPN,WVPNAME,WVPOP,WVPOP1,WVPOST,WVPPAP
 K WVPRE,WVPREG,WVPRIO,WVPRMPT,WVPRMT,WVPRMT1,WVPRMT2,WVPRMTQ,WVPROF
 K WVPROV,WVPRPCD,WVPRV,WVPSTAT,WVPTITL,WVPURP,WVPUSER,WVQUE,WVQUIT
 K WVRCVDT,WVRES,WVRESN,WVRTN,WVS,WVSAME,WVSCRN,WVSITE,WVSL,WVSPEC
 K WVSPTX,WVSS,WVSSN,WVSTART,WVSTAT,WVSTTDT,WVSUB,WVSUBH,WVUSER,WVSV
 K WVTAB,WVTEST,WVTIME,WVTIMLN,WVTITLE,WVTITLE1,WVTITLE2,WVTMP
 K WVTTAB,WVTYPE,WVUNL,WVVER,WVVFIL,WVVGBL,WVX,WVX0,WVX1,WVX2,WVX3
 K WVX4,WVX5,WVX6,WVX7,WVX8,WVX9,WVXPORT,WVXREF,WVY,WVYY
 K COL,COLLEN,LEN,NN,NODE,V,POP,WVJPCP,WVJDT,WVJDTO,WVJNDA,WVJTOY
 K WVTOY,WVJPAPR,WVJST,WVPR,CN,WVCNT,WVJ,WVJAGER,WVJHDR,WVJTYP
 K WVDTIEN,WVJX,WVJDR,WVCN,WVJRNOW,WVBALL,WVALL,WVBV,WVCALL,WVCIVCN
 K WVCNALL,WVCV,WVET,WVETCN,WVMALL,WVMV,WVNALL,WVST,WVVALL,WVARJ
 K WVJBFAC,WVJCFAC
 ;
 ;---> ADDED MANUALLY.
 K WVMDAT,WVMGR,WVPDAT,WVTOT
 K ^TMP("WV",$J)
 ;
 ;---> FILEMAN KILLS.
 D DKILLS^WVFMAN
 K X,Y,Z,ZTRTN,ZTSAVE
 Q