BWCBE ;IHS/ANMC/MWR - UTIL: MOSTLY PATIENT DATA;15-Feb-2003 21:49;PLS
;;2.0;WOMEN'S HEALTH;**1,8**;MAR 30, 2001
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
;; CREATE CBE PROCEDURE IN WOMEN'S HEALTH FOR THIS PATIENT.
;
;
EP(PATDFN,VSIT,VFIEN) ;EP - called from template (APCD CBE (ADD))
I '$G(PATDFN) Q
I '$G(VSIT) Q
S VFIEN=$G(VFIEN)
;S VFRES=$G(VFRES)
S APCDTRES="" ;result to pass back to V EXAM
D EN^XBNEW("EP1^BWCBE","PATDFN;VSIT;VFIEN;APCDTRES")
Q
EP1 ;EP - called from xbnew
NEW RESULT,ERR
S (ERR,APCDTRES)=""
;get result
S BWPN=27,DIR(0)="9002086.1,.05O",DIR("A")="Enter RESULTS/DIAGNOSIS" KILL DA D ^DIR KILL DIR
S RESULT=Y
D ADD(ERR,PATDFN,$P(^AUPNVSIT(VSIT,0),U),VSIT,RESULT,$$PRIMPROV^APCLV(VSIT),VFIEN)
I ERR]"" W "I got an error"
Q
;----------
ADD(BWERR,BWDFN,BWPCCDT,BWVST,BWDX,BWPROV,BWVFDA) ;EP
;---> Add a CBE (Clinical Breast Exam) to this patient.
;---> Parameters:
; 1 - BWERR (ret) Text of error, if any.
; 2 - BWDFN (req) DFN of patient.
; 3 - BWPCCDT (req) PCC Visit Date/Time.
; 4 - BWVST (opt) Visit IEN (if any) to link this CBE to.
; 5 - BWDX (opt) IEN in BW RESULTS/DIAGNOSIS File #9002086.31.
; 6 - BWPROV (opt) Provider pointer to #200.
;
;---> If DFN not provided, set Error Code and quit.
I '$G(BWDFN) D Q
.S BWERR="Software error: Patient DFN not provided."
;
;---> Set required variables.
D ^XBKVAR S BWERR=""
;
;
PATIENT ;---> If Patient isn't in Women's Health Database, add her.
I '$D(^BWP(BWDFN,0)) D
.D AUTOADD^BWPATE(BWDFN,DUZ(2),.BWERR)
.S:BWERR<0 BWERR="Software error: Failed to add new patient."
Q:BWERR]""
;
;
PROC ;---> Create CBE Procedure in BW PROCEDURE File #9002086.1.
;---> 27=IEN of Procedure Type in File #9002086.2.
;
;---> Optional use of DR string.
N BWDA,BWDR
S BWDR=".02////"_BWDFN_";.03////"_$G(BWPCCDT)_";.04////27"
S BWDR=BWDR_";.05////"_$G(BWDX)_";.07////"_$G(BWPROV)
S BWDR=BWDR_";.1////"_DUZ(2)_";.11////"_$G(BWLOC)
S BWDR=BWDR_";.12////"_$P($G(BWPCCDT),".")_";.14////"_$G(BWSTAT)
S BWDR=BWDR_";.18////"_DUZ_";.19////"_DT
;
D NEW2^BWPROC(BWDFN,27,BWPCCDT,BWDR,"",.BWDA,.BWERR)
I BWERR<0 D Q
.S BWERR="Software error: Failed to create CBE in Women's Health."
;
;---> BWDA=IEN of just created Procedure in BW PROCEDURE File.
;---> Following line will call ^APCDALV and ^APCDALVR.
;---> Call to APCDALV will look for same date Visit and prompt
;---> if time does not match. (See +53^BWPCC.)
;D CREATE^BWPCC(BWDA,DUZ(2),$G(^BWPCD(BWDA,0)))
N X S X=$$NORMAL^BWUTL4($P(^BWPCD(BWDA,0),U,5))
S:X<2 APCDTRES=$S(X:"A",1:"N")
STORE ;---> STORE VISIT AND V FILE IEN'S IN WH PROCEDURE FILE #9002086.1.
I $G(BWDA) D
.N DR
.S DR="5.01////"_BWVST_";5.02////"_BWVFDA
.D DIE^BWFMAN(9002086.1,DR,BWDA,.BWPOP)
;
;---> Or, if Visit IEN is known, set required variables and
;---> call VFILE^BWPCC.
Q
BWCBE ;IHS/ANMC/MWR - UTIL: MOSTLY PATIENT DATA;15-Feb-2003 21:49;PLS
+1 ;;2.0;WOMEN'S HEALTH;**1,8**;MAR 30, 2001
+2 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
+3 ;; CREATE CBE PROCEDURE IN WOMEN'S HEALTH FOR THIS PATIENT.
+4 ;
+5 ;
EP(PATDFN,VSIT,VFIEN) ;EP - called from template (APCD CBE (ADD))
+1 IF '$GET(PATDFN)
QUIT
+2 IF '$GET(VSIT)
QUIT
+3 SET VFIEN=$GET(VFIEN)
+4 ;S VFRES=$G(VFRES)
+5 ;result to pass back to V EXAM
SET APCDTRES=""
+6 DO EN^XBNEW("EP1^BWCBE","PATDFN;VSIT;VFIEN;APCDTRES")
+7 QUIT
EP1 ;EP - called from xbnew
+1 NEW RESULT,ERR
+2 SET (ERR,APCDTRES)=""
+3 ;get result
+4 SET BWPN=27
SET DIR(0)="9002086.1,.05O"
SET DIR("A")="Enter RESULTS/DIAGNOSIS"
KILL DA
DO ^DIR
KILL DIR
+5 SET RESULT=Y
+6 DO ADD(ERR,PATDFN,$PIECE(^AUPNVSIT(VSIT,0),U),VSIT,RESULT,$$PRIMPROV^APCLV(VSIT),VFIEN)
+7 IF ERR]""
WRITE "I got an error"
+8 QUIT
+9 ;----------
ADD(BWERR,BWDFN,BWPCCDT,BWVST,BWDX,BWPROV,BWVFDA) ;EP
+1 ;---> Add a CBE (Clinical Breast Exam) to this patient.
+2 ;---> Parameters:
+3 ; 1 - BWERR (ret) Text of error, if any.
+4 ; 2 - BWDFN (req) DFN of patient.
+5 ; 3 - BWPCCDT (req) PCC Visit Date/Time.
+6 ; 4 - BWVST (opt) Visit IEN (if any) to link this CBE to.
+7 ; 5 - BWDX (opt) IEN in BW RESULTS/DIAGNOSIS File #9002086.31.
+8 ; 6 - BWPROV (opt) Provider pointer to #200.
+9 ;
+10 ;---> If DFN not provided, set Error Code and quit.
+11 IF '$GET(BWDFN)
Begin DoDot:1
+12 SET BWERR="Software error: Patient DFN not provided."
End DoDot:1
QUIT
+13 ;
+14 ;---> Set required variables.
+15 DO ^XBKVAR
SET BWERR=""
+16 ;
+17 ;
PATIENT ;---> If Patient isn't in Women's Health Database, add her.
+1 IF '$DATA(^BWP(BWDFN,0))
Begin DoDot:1
+2 DO AUTOADD^BWPATE(BWDFN,DUZ(2),.BWERR)
+3 IF BWERR<0
SET BWERR="Software error: Failed to add new patient."
End DoDot:1
+4 IF BWERR]""
QUIT
+5 ;
+6 ;
PROC ;---> Create CBE Procedure in BW PROCEDURE File #9002086.1.
+1 ;---> 27=IEN of Procedure Type in File #9002086.2.
+2 ;
+3 ;---> Optional use of DR string.
+4 NEW BWDA,BWDR
+5 SET BWDR=".02////"_BWDFN_";.03////"_$GET(BWPCCDT)_";.04////27"
+6 SET BWDR=BWDR_";.05////"_$GET(BWDX)_";.07////"_$GET(BWPROV)
+7 SET BWDR=BWDR_";.1////"_DUZ(2)_";.11////"_$GET(BWLOC)
+8 SET BWDR=BWDR_";.12////"_$PIECE($GET(BWPCCDT),".")_";.14////"_$GET(BWSTAT)
+9 SET BWDR=BWDR_";.18////"_DUZ_";.19////"_DT
+10 ;
+11 DO NEW2^BWPROC(BWDFN,27,BWPCCDT,BWDR,"",.BWDA,.BWERR)
+12 IF BWERR<0
Begin DoDot:1
+13 SET BWERR="Software error: Failed to create CBE in Women's Health."
End DoDot:1
QUIT
+14 ;
+15 ;---> BWDA=IEN of just created Procedure in BW PROCEDURE File.
+16 ;---> Following line will call ^APCDALV and ^APCDALVR.
+17 ;---> Call to APCDALV will look for same date Visit and prompt
+18 ;---> if time does not match. (See +53^BWPCC.)
+19 ;D CREATE^BWPCC(BWDA,DUZ(2),$G(^BWPCD(BWDA,0)))
+20 NEW X
SET X=$$NORMAL^BWUTL4($PIECE(^BWPCD(BWDA,0),U,5))
+21 IF X<2
SET APCDTRES=$SELECT(X:"A",1:"N")
STORE ;---> STORE VISIT AND V FILE IEN'S IN WH PROCEDURE FILE #9002086.1.
+1 IF $GET(BWDA)
Begin DoDot:1
+2 NEW DR
+3 SET DR="5.01////"_BWVST_";5.02////"_BWVFDA
+4 DO DIE^BWFMAN(9002086.1,DR,BWDA,.BWPOP)
End DoDot:1
+5 ;
+6 ;---> Or, if Visit IEN is known, set required variables and
+7 ;---> call VFILE^BWPCC.
+8 QUIT
