source: WorldVistAEHR/trunk/r/WOMENS_HEALTH-WV/WVUTL8.m@ 623

Last change on this file since 623 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.5 KB
Line 
1WVUTL8 ;HCIOFO/FT,JR IHS/ANMC/MWR - UTIL: PATLKUP, SELECT, KILLALL; ;12/15/98 16:43
2 ;;1.0;WOMEN'S HEALTH;**3**;Sep 30, 1998
3 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
4 ;; UTILITY: PATIENT LOOKUP, SELECT FOR REPORT, KILLALL.
5 ;
6PATLKUP(Y,WVADD,DUZ2,WVPOP) ;EP
7 ;---> WV PATIENT LOOKUP.
8 ;---> PARAMETERS:
9 ; 1 - Y (RETURNED) PATIENT DFN OR -1 IF FAILED.
10 ; 2 - WVADD (OPTIONAL) EQUALS "ADD" IF ADD CAPABILITY
11 ; 3 - DUZ2=DUZ(2) (OPTIONAL) IF NOT SET, WILL=ENVIROMENTAL DUZ(2)
12 ; 4 - WVPOP (RETURNED) WVPOP=1 IF DTOUT OR DUOUT
13 ;
14 ;---> EXAMPLE: D PATLKUP^WVUTL8(.Y)
15 ; D PATLKUP^WVUTL8(.Y,"ADD") - MAY ADD PATIENT TO WH.
16 ;
17 N DFN,DIC,X
18PATLKUP1 ;---> RETURN HERE IF LOOKUP FAILED FOR SEX OR AGE.
19 ;---> SET VARIABLES: Y=DFN,WVPOP=1 FOR QUIT.
20 S WVPOP=0 D SETVARS^WVUTL5
21 S:$G(DUZ2)]"" DUZ(2)=DUZ2
22 S DIC="^DPT(",DIC(0)="AEMQ",DIC("S")="I $P(^(0),U,2)=""F"""
23 D ^DIC
24 Q:$D(DUOUT)!($D(DTOUT))
25 Q:Y<0
26 S (DFN,Y)=+Y
27 ;---> IF PATIENT ALREADY EXISTS IN WV PATIENT FILE, QUIT.
28 Q:$D(^WV(790,DFN,0))
29 ;
30 ;---> IF PATIENT IS NOT FEMALE, PROMPT USER.
31 I '$$SEX^WVUTL1(DFN) D G PATLKUP1
32 .W !!?3,$$NAME^WVUTL1(DFN)," is not female." D DIRZ^WVUTL3
33 ;
34 ;---> QUIT IF NO ADD ("LAYGO") CAPABILITY.
35 I $G(WVADD)'="ADD" D G PATLKUP1
36 .W !!?3,$$NAME^WVUTL1(DFN)
37 .W " is not currently in the Women's Health database." D DIRZ^WVUTL3
38 ;
39 ;---> ASK TO ADD AS A NEW PATIENT.
40 W !!?3,$$NAME^WVUTL1(DFN)
41 W " ("_$$AGE^WVUTL1(DFN)_")" ;show patient's age
42 W !?3,"is not currently in the Women's Health database."
43 W !?3,"Do you wish to add her to the Women's Health Database?"
44 S DIR("?",1)=" Enter YES to ADD this patient to the Women's Health"
45 S DIR("?",1)=DIR("?",1)_" database."
46 S DIR("?")=" Enter NO to quit without adding her to the database."
47 S DIR(0)="Y",DIR("A")=" Enter Yes or No"
48 D ^DIR W !
49 I $D(DIRUT) S Y=-1 Q
50 G:Y=0 PATLKUP1
51 D AUTOADD^WVPATE(DFN,DUZ(2),.Y,1)
52 Q
53 ;
54KGBL(GBL) ;EP
55 ;---> KILL A GLOBAL. GBL SHOULD INCLUDE THE LEADING "^".
56 S:GBL["(" GBL=$P(GBL,"(")
57 F S GBL=$Q(@GBL) Q:GBL="" K @GBL
58 Q
59 ;
60ZGBL(GBL) ;EP
61 ;---> ZERO OUT (DELETE ALL DATA) IN A FILEMAN FILE.
62 ;---> GBL SHOULD INCLUDE THE LEADING "^".
63 N N,X
64 S:GBL["(" GBL=$P(GBL,"(")
65 Q:'$D(@(GBL_"(0)"))
66 S N=0,X=$P(@(GBL_"(0)"),U,1,2)
67 F S N=$O(@(GBL_"("""_N_""")")) Q:N="" K @(GBL_"("""_N_""")")
68 S @(GBL_"(0)")=X
69 Q
70 ;
71KILLALL ;EP
72 ;---> CLEAN UP VARIABLES.
73 ;---> MSM
74 ;S X="WV" F S X=$O(@X) Q:$E(X,1,2)'="WV" K @X
75 ;S X="DI" F S X=$O(@X) Q:$E(X,1,2)'="WV" K @X
76 ;---> DSM
77 ;S X="WV" F S X=$ZSORT(@X) Q:$E(X,1,2)'="WV" K @X
78 ;S X="DI" F S X=$ZSORT(@X) Q:$E(X,1,2)'="WV" K @X
79 ;
80 ;---> REPLACE KILLS BELOW WITH $O COMMANDS ABOVE WHEN AVAILABLE.
81 K WV,WV0,WV1,WV1DX,WV2,WV2DX,WVA,WVABBV,WVABBVS,WVACC
82 K WVACCN,WVACCP,WVADD,WVAGE,WVAGENCY,WVAGRG,WVAGRP,WVAR,WVAREA
83 K WVARR,WVARR1,WVASKTIM,WVATT,WVB,WVBDF,WVBEGDF,WVBEGDT
84 K WVBEGDT1,WVBNEED,WVC,WVC0,WVCAPT,WVCBEDA,WVCC,WVCDC,WVCDCV,WVCHAGE
85 K WVCHG,WVCHRT,WVCHSSN,WVCMGR,WVCMGR1,WVCNEED,WVCODE,WVCOLPS,WVCONF
86 K WVCONFF,WVCOUNT,WVCRT,WVCUR,WVD,WVDA,WVDATE,WVDATE1,WVDD,WVDDATE
87 K WVDEF,WVDFLT,WVDFN,WVDIAG,WVDR,WVDT,WVDUZ0,WVDUZ2,WVDX
88 K WVE,WVEDC,WVEDCL,WVEDF,WVENDDF,WVENDDT,WVENDDT1,WVENDSAM,WVENDT
89 K WVERR,WVERROR,WVERRORS,WVFAC,WVFACIL,WVFILE,WVFLNM,WVGBL
90 K WVGBLN,WVHEADER,WVHCF,WVHFS,WVHLOC,WVHRCN,WVI,WVICD,WVIEN,WVION
91 K WVITEM,WVITEMS,WVKDT,WVLDAT,WVLFRT,WVLINE,WVLINL,WVLOC,WVLOGO
92 K WVLOOP,WVLPRG,WVM,WVMABN,WVMAM,WVMAMDT,WVMATCH,WVMENUT,WVMES,WVN
93 K WVNAMAGE,WVNAME,WVNEW,WVNN,WVNODE,WVNOFAC,WVNOFOL,WVNOMAT,WVNORM
94 K WVNOW,WVOFAC,WVOLD,WVOLD2,WVOUT,WVPABN,WVPAGE,WVPAP,WVPAPDA,WVPAPDT
95 K WVPAPRG,WVPAPRG1,WVPAPS,WVPATH,WVPATS,WVPC,WVPCCN,WVPCCP,WVPCD,WVPCDL
96 K WVPCDN,WVPCDS,WVPCDT,WVPDATE,WVPN,WVPNAME,WVPOP,WVPOP1,WVPOST,WVPPAP
97 K WVPRE,WVPREG,WVPRIO,WVPRMPT,WVPRMT,WVPRMT1,WVPRMT2,WVPRMTQ,WVPROF
98 K WVPROV,WVPRPCD,WVPRV,WVPSTAT,WVPTITL,WVPURP,WVPUSER,WVQUE,WVQUIT
99 K WVRCVDT,WVRES,WVRESN,WVRTN,WVS,WVSAME,WVSCRN,WVSITE,WVSL,WVSPEC
100 K WVSPTX,WVSS,WVSSN,WVSTART,WVSTAT,WVSTTDT,WVSUB,WVSUBH,WVUSER,WVSV
101 K WVTAB,WVTEST,WVTIME,WVTIMLN,WVTITLE,WVTITLE1,WVTITLE2,WVTMP
102 K WVTTAB,WVTYPE,WVUNL,WVVER,WVVFIL,WVVGBL,WVX,WVX0,WVX1,WVX2,WVX3
103 K WVX4,WVX5,WVX6,WVX7,WVX8,WVX9,WVXPORT,WVXREF,WVY,WVYY
104 K COL,COLLEN,LEN,NN,NODE,V,POP,WVJPCP,WVJDT,WVJDTO,WVJNDA,WVJTOY
105 K WVTOY,WVJPAPR,WVJST,WVPR,CN,WVCNT,WVJ,WVJAGER,WVJHDR,WVJTYP
106 K WVDTIEN,WVJX,WVJDR,WVCN,WVJRNOW,WVBALL,WVALL,WVBV,WVCALL,WVCIVCN
107 K WVCNALL,WVCV,WVET,WVETCN,WVMALL,WVMV,WVNALL,WVST,WVVALL,WVARJ
108 K WVJBFAC,WVJCFAC
109 ;
110 ;---> ADDED MANUALLY.
111 K WVMDAT,WVMGR,WVPDAT,WVTOT
112 K ^TMP("WV",$J)
113 ;
114 ;---> FILEMAN KILLS.
115 D DKILLS^WVFMAN
116 K X,Y,Z,ZTRTN,ZTSAVE
117 Q
Note: See TracBrowser for help on using the repository browser.