source: FOIAVistA/tag/r/WOMENS_HEALTH-WV/WVUTL3.m@ 628

WVUTL3 ;HCIOFO/FT,JR IHS/ANMC/MWR - UTIL: DATE, LOCK, DIR, PATVARS; ;8/11/98  09:23
 ;;1.0;WOMEN'S HEALTH;;Sep 30, 1998
 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
 ;;  UTILITY: ASK DATE RANGE, LOCKS, DIR PROMPTS, STORE/DEL EDC,
 ;;  STORE PAP REGIMEN, PCDVARS & PATVARS.
 ;
 ;
OUT ;EP
 ;---> CALLED AFTER ERROR MESSAGES ARE DISPLAYED.
 S WVPOP=1 D DIRZ
 Q
 ;
ASKDATES(WVB,WVE,WVPOP,WVBDF,WVEDF,WVSAME,WVTIME) ;EP
 ;---> ASK DATE RANGE.
 ;---> PARAMETERS:
 ;     1 - WVB    (RETURNED) BEGIN DATE, FILEMAN FORMAT
 ;     2 - WVE    (RETURNED) END DATE, FILEMAN FORMAT
 ;     3 - WVPOP  (RETURNED) WVPOP=1 IF QUIT,FAIL,DTOUT,DUOUT
 ;     4 - WVBDF  (OPTIONAL) BEGIN DATE DEFAULT, FILEMAN FORMAT
 ;     5 - WVEDF  (OPTIONAL) END DATE DEFAULT, FILEMAN FORMAT
 ;     6 - WVSAME (OPTIONAL) FORCE END DATE DEFAULT=BEGIN DATE
 ;     7 - WVTIME (OPTIONAL) ASK TIMES
 ;
 ;---> EXAMPLE:
 ;        D ASKDATES^WVUTL3(.WVBEGDT,.WVENDDT,.WVPOP,"T-365","T")
 ;
 S WVPOP=0 N %DT,Y
 W !!,"   *** Date Range Selection ***"
 S %DT="APEX"_$S($D(WVTIME):"T",1:"")
 S %DT("A")="   Begin with DATE: "
 I $G(WVBDF)]"" S Y=WVBDF D DD^%DT S %DT("B")=Y
 D ^%DT K %DT
 I Y<0 S WVPOP=1 Q
 S (%DT(0),WVB)=Y K %DT("B")
 S %DT="APEX"_$S($D(WVTIME):"T",1:"")
 S %DT("A")="   End with DATE:   "
 I $G(WVEDF)]"" S Y=WVEDF D DD^%DT S %DT("B")=Y
 I $D(WVSAME) S Y=WVB D DD^%DT S %DT("B")=Y
 D ^%DT K %DT
 I Y<0 S WVPOP=1 Q
 S WVE=Y
 Q
 ;
LOCKED ;EP
 Q:$D(ZTQUEUED)  ;quit if called from a background (tasked) job.
 W !?5,"Another user is editing this entry.  Please, try again later."
 D DIRZ
 Q
 ;
LOCKEDE ;EP
 ;---> LOCKED PREGNANCY LOG ENTRY.
 W !?5,"Another user is editing the Pregnancy Log for this patient"
 W !?5,"for this day.  Please, try again later."
 D DIRZ
 Q
 ;
LOCKEDP ;EP
 ;---> LOCKED PAP Regimen Log ENTRY.
 W !?5,"Another user is editing the PAP Regimen Log for this patient"
 W !?5,"for this day.  Please, try again later."
 D DIRZ
 Q
 ;
 ;
DIRZ ;EP
 ;---> PRESS RETURN TO CONTINUE.
 N DIR,DIRUT,X,Y
 I $D(WVPRMT) S DIR("A")=WVPRMT
 I $D(WVPRMT1) S DIR("A",1)=WVPRMT1
 I $D(WVPRMT2) S DIR("A",2)=WVPRMT2
 I $D(WVPRMTQ) S DIR("?")=WVPRMTQ
 S DIR(0)="E" W ! D ^DIR W !
 S WVPOP=$S($D(DIRUT):1,Y<1:1,1:0)
 Q
 ;
DIRPRMT ;EP
 ;---> REQUIRED VARIABLE: WVPROMPT,M (M=LAST SELECTION# DISPLAYED)
 ;---> OPTIONAL VARIABLE: WVCODE (EXECUTABLE CODE ACTING ON INPUT X)
 ;---> WVD=1 IF RANGE OF SELECTION NUMBERS SHOULD BE DISPLAYED.
 N DIR,DIRUT,Y
 W ! S:'$D(WVD) WVD=0
 S DIR(0)="LO^"_$S(WVD:":"_M,1:"1:"_M)
 I $D(WVPRMT) S DIR("A")=WVPRMT
 I $D(WVPRMT1) S DIR("A",1)=WVPRMT1
 I $D(WVPRMT2) S DIR("A",2)=WVPRMT2
 I $D(WVPRMTQ) S DIR("?")=WVPRMTQ
 I $D(WVCODE) S DIR(0)=DIR(0)_U_WVCODE
 D ^DIR
 S:$D(DTOUT)!($D(DUOUT)) WVPOP=1
 Q
 ;
STOREDC ;EP
 ;---> STORE PREGNANCY AND EDC, CALLED BY MUMPS XREF ON FIELDS #.13
 ;---> AND #.14 IN WV PATIENT FILE.  NOTE: WHEN AN EDIT IS DONE,
 ;---> FIRST KILL AND THEN SET LOGIC OF THE MUMPS XREF IS EXECUTED;
 ;---> BUT FOR A DELETE (@), ONLY THE KILL LOGIC IS EXECUTED.
 ;---> REQUIRED VARIABLES: WVDFN, WVPREG=PREGNANT(1=YES,0=NO), WVEDC=EDC
 Q:'$D(WVEDC)!('$D(WVPREG))!('$D(WVDFN))
 Q:'WVDFN
 N DA,DIC,DIE,DG,DLAYGO,DR,N,WVQUIT,X
 D SETVARS^WVUTL5
 S WVQUIT=0,DLAYGO=790
 I WVPREG="" D DELETEDC Q
 S:WVPREG=0 WVEDC=0
 S DIE="^WV(790.05,",DR=".03////"_WVPREG_";.04////"_+WVEDC
 S N=0
 F  S N=$O(^WV(790.05,"C",WVDFN,N)) Q:'N  D
 .I $D(^WV(790.05,"B",DT,N)) S DA=N D
 ..L +^WV(790.05,DA):0 I '$T D LOCKEDE S WVQUIT=1 Q
 ..D DIE^WVFMAN(790.05,DR,DA) L -^WV(790.05,DA) S WVQUIT=1
 Q:WVQUIT
 ;
 K DD,DO
 S DIC="^WV(790.05,",DIC(0)="L",X=DT,DLAYGO=790
 S DIC("DR")=".02////"_WVDFN_";.03////"_WVPREG_";.04////"_+WVEDC
 D FILE^DICN
 Q
 ;
DELETEDC ;EP
 ;---> DELETE PREGANCY LOG ENTRY FOR THIS DAY (DT).
 S DIK="^WV(790.05,"
 S N=0
 F  S N=$O(^WV(790.05,"C",WVDFN,N)) Q:'N  D
 .I $D(^WV(790.05,"B",DT,N)) S DA=N D ^DIK
 Q
 ;
STORPAP ;EP
 ;---> STORE PAP REGIMEN, START DATE AND DATE ENTERED; CALLED BY
 ;---> MUMPS XREF ON FIELDS #.16 AND #.17 IN WV PATIENT FILE.
 ;---> REQUIRED VARIABLES: WVLDAT=BEGIN DATE, WVLPRG=PAP REGIMEN, WVDFN.
 Q:'$D(WVLDAT)!('$D(WVLPRG))!('$D(WVDFN))
 Q:'WVLDAT!('WVLPRG)!('WVDFN)
 N DA,DIC,DIE,DLAYGO,DR,N,WVQUIT,X,DG
 D SETVARS^WVUTL5
 S WVQUIT=0,DLAYGO=790
 S DIE="^WV(790.04,"
 S DR=".01////"_WVLDAT_";.03////"_WVLPRG
 S N=0
 F  S N=$O(^WV(790.04,"C",WVDFN,N)) Q:'N!(WVQUIT)  D
 .I $D(^WV(790.04,"B",WVLDAT,N)) S DA=N D
 ..L +^WV(790.04,DA):0 I '$T D LOCKEDP S WVQUIT=1 Q
 ..D DIE^WVFMAN(790.04,DR,DA,.WVPOP) L -^WV(790.04,DA) S WVQUIT=1
 Q:WVQUIT
 ;
 K DD,DO
 S DIC="^WV(790.04,",DIC(0)="L",X=WVLDAT,DLAYGO=790
 S DIC("DR")=".02////"_WVDFN_";.03////"_WVLPRG
 D FILE^DICN
 Q
 ;
 ;
PCDVARS(DA,TEXTDATE,COLP) ;EP
 ;---> SET VARIABLES FOR PROCEDURE DATA FOR HEADERS.
 ;---> REQUIRED VARIABLES: DA=IEN OF PROCEDURE IN PROC FILE 790.1.
 ;--->               TEXTDATE=1 PROVIDE DATE IN TEXT FORMAT,
 ;--->                          OTHERWISE IN NUMERIC FORMAT (1/1/95)
 ;--->                   COLP=1 TO SET WVC0=ASSOC'D COLP IF THIS IS
 ;--->                          A PAP.
 ;---> Y=ZERO NODE OF PROCEDURE, WVACCN=ACCESSION#,
 ;---> WVPCDN=IEN OF PROCEDURE TYPE,
 ;---> WVRESN=IEN OF RESULT/DIAG,WVRES=TEXT OF RESULT/DIAG
 ;---> WVPN=PROCEDURE TYPE, WVDFN=DFN OF PATIENT.
 ;---> WV0=ZERO NODE OF THIS PROCEDURE, WV2=TWO NODE.
 ;---> WVPAP=1=PCD IS A PAP, WVMAM=1=PCD IS A SCREENING MAM.
 ;---> WVC0=ZERO NODE OF ASSOCIATED COLP (IF THIS IS A PAP).
 ;
 N X,Y S (WV0,Y)=^WV(790.1,DA,0),WVC0=""
 S WV2=$S($D(^WV(790.1,DA,2)):^(2),1:"")
 S COLP=$G(COLP) S:COLP WVC0=$$COLP0^WVUTL4(DA)
 S TEXTDATE=$G(TEXTDATE)
 S WVACCN=$$ACC^WVUTL1(DA)
 S WVPCDN=$P(Y,U,4)
 S X=DA,WVPN=$$PROC^WVUTL1A
 S WVRESN=$P(Y,U,5),WVRES=$$DIAG^WVUTL4(WVRESN)
 S X=$P(Y,U,7),WVPROV=$$PROV^WVUTL6
 S WVDFN=$P(Y,U,2) D PATVARS(WVDFN,TEXTDATE)
 S (WVMAM,WVPAP)=0
 S:WVPCDN=28 WVMAM=1 S:WVPCDN=1 WVPAP=1
 Q
 ;
PATVARS(DFN,TEXTDATE) ;EP
 ;---> SET VARIABLES FO PATIENT DATA FOR HEADERS.
 ;---> REQUIRED VARIABLES: WVDFN=IEN OF PATIENT
 ;---> YIELDS: WVNAME=PATIENT NAME, WVCHRT=SSN#
 ;---> WVCMGR=CASE MANAGER, WVCNEED=CX TX NEED,
 ;---> WVPAPRG=PAP REGIMEN, WVBNEED=BR TX NEED, WVEDC=EDC.
 S TEXTDATE=$G(TEXTDATE)
 S WVNAME=$$NAME^WVUTL1(DFN)
 S WVNAMAGE=$$NAMAGE^WVUTL1(DFN)
 S WVCHRT=$$SSN^WVUTL1(DFN)
 S WVCMGR=$$CMGR^WVUTL1(DFN)
 S WVCNEED=$$CNEED^WVUTL1(DFN,TEXTDATE)
 S WVPAPRG=$$PAPRG^WVUTL1(DFN,TEXTDATE)
 S WVBNEED=$$BNEED^WVUTL1(DFN,TEXTDATE)
 S WVEDC=$$EDC^WVUTL1(DFN)
 Q