Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BWUTL3

BWUTL3.m

Go to the documentation of this file. 
  1. BWUTL3 ;IHS/ANMC/MWR - UTIL: DATE, LOCK, DIR, PATVARS;12-Feb-2003 10:41;PLS
  1.  ;;2.0;WOMEN'S HEALTH;**8**;MAY 16, 1996
  1.  ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
  1.  ;;  UTILITY: ASK DATE RANGE, LOCKS, DIR PROMPTS, STORE/DEL EDC,
  1.  ;;  STORE PAP REGIMEN, PCDVARS & PATVARS.
  1.  ;
  1.  ;
  1. OUT ;EP
  1.  ;---> CALLED AFTER ERROR MESSAGES ARE DISPLAYED.
  1.  S BWPOP=1 D DIRZ
  1.  Q
  1.  ;
  1. ASKDATES(BWB,BWE,BWPOP,BWBDF,BWEDF,BWSAME,BWTIME) ;EP
  1.  ;---> ASK DATE RANGE.
  1.  ;---> PARAMETERS:
  1.  ;     1 - BWB    (RETURNED) BEGIN DATE, FILEMAN FORMAT
  1.  ;     2 - BWE    (RETURNED) END DATE, FILEMAN FORMAT
  1.  ;     3 - BWPOP  (RETURNED) BWPOP=1 IF QUIT,FAIL,DTOUT,DUOUT
  1.  ;     4 - BWBDF  (OPTIONAL) BEGIN DATE DEFAULT, FILEMAN FORMAT
  1.  ;     5 - BWEDF  (OPTIONAL) END DATE DEFAULT, FILEMAN FORMAT
  1.  ;     6 - BWSAME (OPTIONAL) FORCE END DATE DEFAULT=BEGIN DATE
  1.  ;     7 - BWTIME (OPTIONAL) ASK TIMES
  1.  ;
  1.  ;---> EXAMPLE:
  1.  ;        D ASKDATES^BWUTL3(.BWBEGDT,.BWENDDT,.BWPOP,"T-365","T")
  1.  ;
  1.  S BWPOP=0 N %DT,Y
  1.  W !!,"   *** Date Range Selection ***"
  1.  S %DT="APEX"_$S($D(BWTIME):"T",1:"")
  1.  S %DT("A")="   Begin with DATE: "
  1.  I $G(BWBDF)]"" S Y=BWBDF D DD^%DT S %DT("B")=Y
  1.  D ^%DT K %DT
  1.  I Y<0 S BWPOP=1 Q
  1.  S (%DT(0),BWB)=Y K %DT("B")
  1.  S %DT="APEX"_$S($D(BWTIME):"T",1:"")
  1.  S %DT("A")="   End with DATE..: " ;IHS/CMI/THL PATCH 8
  1.  I $G(BWEDF)]"" S Y=BWEDF D DD^%DT S %DT("B")=Y
  1.  I $D(BWSAME) S Y=BWB D DD^%DT S %DT("B")=Y
  1.  D ^%DT K %DT
  1.  I Y<0 S BWPOP=1 Q
  1.  S BWE=Y
  1.  Q
  1.  ;
  1. LOCKED ;EP
  1.  W !?5,"Another user is editing this entry.  Please, try again later."
  1.  D DIRZ
  1.  Q
  1.  ;
  1. LOCKEDE ;EP
  1.  ;---> LOCKED PREGNANCY LOG ENTRY.
  1.  W !?5,"Another user is editing the Pregnancy Log for this patient"
  1.  W !?5,"for this day.  Please, try again later."
  1.  D DIRZ
  1.  Q
  1.  ;
  1. LOCKEDP ;EP
  1.  ;---> LOCKED PREGNANCY LOG ENTRY.
  1.  W !?5,"Another user is editing the PAP Regimen Log for this patient"
  1.  W !?5,"for this day.  Please, try again later."
  1.  D DIRZ
  1.  Q
  1.  ;
  1.  ;
  1. DIRZ ;EP
  1.  ;---> PRESS RETURN TO CONTINUE.
  1.  N DIR,DIRUT,X,Y
  1.  I $D(BWPRMT) S DIR("A")=BWPRMT
  1.  I $D(BWPRMT1) S DIR("A",1)=BWPRMT1
  1.  I $D(BWPRMT2) S DIR("A",2)=BWPRMT2
  1.  I $D(BWPRMTQ) S DIR("?")=BWPRMTQ
  1.  S DIR(0)="E" W ! D ^DIR W !
  1.  S BWPOP=$S($D(DIRUT):1,Y<1:1,1:0)
  1.  Q
  1.  ;
  1. DIRPRMT ;EP
  1.  ;---> REQUIRED VARIABLE: BWPROMPT,M (M=LAST SELECTION# DISPLAYED)
  1.  ;---> OPTIONAL VARIABLE: BWCODE (EXECUTABLE CODE ACTING ON INPUT X)
  1.  ;---> BWD=1 IF RANGE OF SELECTION NUMBERS SHOULD BE DISPLAYED.
  1.  N DIR,DIRUT,Y
  1.  W ! S:'$D(BWD) BWD=0
  1.  S DIR(0)="LO^"_$S(BWD:":"_M,1:"1:"_M)
  1.  I $D(BWPRMT) S DIR("A")=BWPRMT
  1.  I $D(BWPRMT1) S DIR("A",1)=BWPRMT1
  1.  I $D(BWPRMT2) S DIR("A",2)=BWPRMT2
  1.  I $D(BWPRMTQ) S DIR("?")=BWPRMTQ
  1.  I $D(BWCODE) S DIR(0)=DIR(0)_U_BWCODE
  1.  D ^DIR
  1.  S:$D(DTOUT)!($D(DUOUT)) BWPOP=1
  1.  Q
  1.  ;
  1. STOREDC ;EP
  1.  ;---> STORE PREGNANCY AND EDC, CALLED BY MUMPS XREF ON FIELDS #.13
  1.  ;---> AND #.14 IN BW PATIENT FILE.  NOTE: WHEN AN EDIT IS DONE,
  1.  ;---> FIRST KILL AND THEN SET LOGIC OF THE MUMPS XREF IS EXECUTED;
  1.  ;---> BUT FOR A DELETE (@), ONLY THE KILL LOGIC IS EXECUTED.
  1.  ;---> REQUIRED VARIABLES: BWDFN, BWPREG=PREGNANT(1=YES,0=NO), BWEDC=EDC
  1.  Q:'$D(BWEDC)!('$D(BWPREG))!('$D(BWDFN))
  1.  Q:'BWDFN
  1.  N (BWEDC,BWPREG,BWDFN,DT,DTIME,DUZ,N,U) D SETVARS^BWUTL5
  1.  D NOW^%DTC S DT=X K X
  1.  S BWQUIT=0,DLAYGO=9002086
  1.  I BWPREG="" D DELETEDC Q
  1.  S:BWPREG=0 BWEDC=0
  1.  S DIE="^BWEDC(",DR=".03////"_BWPREG_";.04////"_+BWEDC
  1.  S DR=DR_";.05///NOW;.06////"_DUZ
  1.  S N=0
  1.  F  S N=$O(^BWEDC("C",BWDFN,N)) Q:'N  D
  1.  .I $D(^BWEDC("B",DT,N)) S DA=N D
  1.  ..L +^BWEDC(DA):0 I '$T D LOCKEDE S BWQUIT=1 Q
  1.  ..D DIE^BWFMAN(9002086.05,DR,DA) L -^BWEDC(DA) S BWQUIT=1
  1.  Q:BWQUIT
  1.  ;
  1.  K DD,DO
  1.  S DIC="^BWEDC(",DIC(0)="L",X=DT,DLAYGO=9002086
  1.  S DIC("DR")=".02////"_BWDFN_";.03////"_BWPREG_";.04////"_+BWEDC
  1.  S DIC("DR")=DIC("DR")_";.05///NOW;.06////"_DUZ
  1.  D FILE^DICN
  1.  Q
  1.  ;
  1. DELETEDC ;EP
  1.  ;---> DELETE PREGANCY LOG ENTRY FOR THIS DAY (DT).
  1.  S DIK="^BWEDC("
  1.  S N=0
  1.  F  S N=$O(^BWEDC("C",BWDFN,N)) Q:'N  D
  1.  .I $D(^BWEDC("B",DT,N)) S DA=N D ^DIK
  1.  Q
  1.  ;
  1. STORPAP ;EP
  1.  ;---> STORE PAP REGIMEN, START DATE AND DATE ENTERED; CALLED BY
  1.  ;---> MUMPS XREF ON FIELDS #.15 AND #.16 IN BW PATIENT FILE.
  1.  ;---> REQUIRED VARIABLES: BWLDAT=BEGIN DATE, BWLPRG=PAP REGIMEN, BWDFN.
  1.  Q:'$D(BWLDAT)!('$D(BWLPRG))!('$D(BWDFN))
  1.  Q:'BWLDAT!('BWLPRG)!('BWDFN)
  1.  N (BWLDAT,BWLPRG,BWDFN,DT,DTIME,DUZ,U) D SETVARS^BWUTL5
  1.  S BWQUIT=0,DLAYGO=9002086
  1.  S DIE="^BWPLOG("
  1.  S DR=".01////"_BWLDAT_";.03////"_BWLPRG
  1.  S DR=DR_";.05///NOW;.06////"_DUZ
  1.  S N=0
  1.  F  S N=$O(^BWPLOG("C",BWDFN,N)) Q:'N!(BWQUIT)  D
  1.  .I $D(^BWPLOG("B",BWLDAT,N)) S DA=N D
  1.  ..L +^BWPLOG(DA):0 I '$T D LOCKEDP S BWQUIT=1 Q
  1.  ..D DIE^BWFMAN(9002086.04,DR,DA,.BWPOP) L -^BWPLOG(DA) S BWQUIT=1
  1.  Q:BWQUIT
  1.  ;
  1.  K DD,DO
  1.  S DIC="^BWPLOG(",DIC(0)="L",X=BWLDAT,DLAYGO=9002086
  1.  S DIC("DR")=".02////"_BWDFN_";.03////"_BWLPRG
  1.  S DIC("DR")=DIC("DR")_";.05///NOW;.06////"_DUZ
  1.  D FILE^DICN
  1.  Q
  1.  ;
  1.  ;
  1. PCDVARS(DA,TEXTDATE,COLP) ;EP
  1.  ;---> SET VARIABLES FOR PROCEDURE DATA FOR HEADERS.
  1.  ;---> REQUIRED VARIABLES: DA=IEN OF PROCEDURE IN PROC FILE 9002086.1.
  1.  ;--->               TEXTDATE=1 PROVIDE DATE IN TEXT FORMAT,
  1.  ;--->                          OTHERWISE IN NUMERIC FORMAT (1/1/95)
  1.  ;--->                   COLP=1 TO SET BWC0=ASSOC'D COLP IF THIS IS
  1.  ;--->                          A PAP.
  1.  ;---> Y=ZERO NODE OF PROCEDURE, BWACCN=ACCESSION#,
  1.  ;---> BWPCDN=IEN OF PROCEDURE TYPE,
  1.  ;---> BWRESN=IEN OF RESULT/DIAG,BWRES=TEXT OF RESULT/DIAG
  1.  ;---> BWPN=PROCEDURE TYPE, BWDFN=DFN OF PATIENT.
  1.  ;---> BW0=ZERO NODE OF THIS PROCEDURE, BW2=TWO NODE.
  1.  ;---> BWPAP=1=PCD IS A PAP, BWMAM=1=PCD IS A SCREENING MAM.
  1.  ;---> BWC0=ZERO NODE OF ASSOCIATED COLP (IF THIS IS A PAP).
  1.  ;
  1.  N X,Y S (BW0,Y)=^BWPCD(DA,0),BWC0=""
  1.  S BW2=$S($D(^BWPCD(DA,2)):^(2),1:"")
  1.  S COLP=$G(COLP) S:COLP BWC0=$$COLP0^BWUTL4(DA)
  1.  S TEXTDATE=$G(TEXTDATE)
  1.  S BWACCN=$$ACC^BWUTL1(DA)
  1.  S BWPCDN=$P(Y,U,4)
  1.  S X=DA,BWPN=$$PROC^BWUTL1
  1.  S BWRESN=$P(Y,U,5),BWRES=$$DIAG^BWUTL4(BWRESN)
  1.  S X=$P(Y,U,7),BWPROV=$$PROV^BWUTL6
  1.  S BWDFN=$P(Y,U,2) D PATVARS(BWDFN,TEXTDATE)
  1.  S (BWMAM,BWPAP)=0
  1.  ;S:BWPCDN=28 BWMAM=1
  1.  S:"^28^25^26^"[(U_BWPCDN_U) BWMAM=1
  1.  S:BWPCDN=1 BWPAP=1
  1.  Q
  1.  ;
  1. PATVARS(DFN,TEXTDATE) ;EP
  1.  ;---> SET VARIABLES FO PATIENT DATA FOR HEADERS.
  1.  ;---> REQUIRED VARIABLES: BWDFN=IEN OF PATIENT
  1.  ;---> YIELDS: BWNAME=PATIENT NAME, BWCHRT=CHART#
  1.  ;---> BWCMGR=CASE MANAGER, BWCNEED=CX TX NEED,
  1.  ;---> BWPAPRG=PAP REGIMEN, BWBNEED=BR TX NEED, BWEDC=EDC.
  1.  S TEXTDATE=$G(TEXTDATE)
  1.  S BWNAME=$$NAME^BWUTL1(DFN)
  1.  S BWNAMAGE=$$NAMAGE^BWUTL1(DFN)
  1.  S BWCHRT=$$HRCN^BWUTL1(DFN)
  1.  S BWCMGR=$$CMGR^BWUTL1(DFN)
  1.  S BWCNEED=$$CNEED^BWUTL1(DFN,TEXTDATE)
  1.  S BWPAPRG=$$PAPRG^BWUTL1(DFN,TEXTDATE)
  1.  S BWBNEED=$$BNEED^BWUTL1(DFN,TEXTDATE)
  1.  S BWEDC=$$EDC^BWUTL1(DFN)
  1.  Q