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