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