BWMDE21 ;IHS/ANMC/MWR - MDE FUNCTIONS. BWMDE2 CON'T;15-Feb-2003 21:58;PLS
;;2.0;WOMEN'S HEALTH;**5,7,8**;MAY 16, 1996
;;Modified for Y2K compliance THL/HJT 5/14/99
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
;; CDC EXPORT, FUNCTIONS TO RETRIEVE DATA FOR INDIVIDUAL FIELDS
;; FOR EXPORT.
;
;IHS/CMI/THL - CONTINUATION OF BWMDE2 - PATCH 7
;
MPREV() ;EP
;---> BUILD BW("MAM") ARRAY OF PREVIOUS MAMS. RETURN 3 IF NONE.
Q:'BWMAM 3
N N,Y K BW("MAM") S N=0
F S N=$O(^BWPCD("C",BWDFN,N)) Q:'N D
.S Y=^BWPCD(N,0)
.I $$PMAM^BWUTL6(+$P(Y,U,4)) D
..S BWMAMDT=$P(Y,U,12)
..Q:BWMAMDT'<$P(BW0,U,12)
..S BW("MAM",9999999-BWMAMDT)=BWMAMDT
Q:$D(BW("MAM")) 1
Q 3
;
MPREVDT() ;EP
;---> USE ABOVE BW("MAM") ARRAY TO RETURN DATE OF PREVIOUS MAM.
Q:'BWMAM ""
Q:'$D(BW("MAM")) ""
N N
S N=$O(BW("MAM",0))
;Begin Y2k fix
;I N S N=BW("MAM",N) K BW("MAM") Q $E(N,4,5)_$E(N,2,3)
;
;MOD PER THL 03/25/99 FOR CDC V4.0 AND Y2K COMPLIANCE
;
I N S N=BW("MAM",N) K BW("MAM") Q $E(N,4,5)_($E(N,1,3)+1700) ;Y2000
;
;END MOD PER THL 03/25/99 FOR CDC V4.0 AND Y2K COMPLIANCE
;End Y2k fix
;
Q ""
;
MRESLT() ;EP
;---> IF THIS PCD IS NOT MAM:
;---> RETURN 9 IF BR TX NEED=MAM AND DUE DATE IS BEFORE TODAY.
;---> RETURN 8 IF BR TX NEED'=MAM, OR IF BR TX NEED=MAM BUT DUE DATE
;---> IS AFTER TODAY.
;---> BOTH CASES SET BWMABN=0 (ABNORMAL MAM=0).
;---> (BWMABN=0 WILL BLANK FILL ALL DATA IN ABNORMAL MAM SECTION.)
;
I 'BWMAM S BWMABN=0 Q " 8"
;---> THIS PROCEDURE MUST BE A MAM.
;---> IF NO RESULT, RETURN 10 (RESULT PENDING) AND SET BWMABN=0.
I 'BWRESN S BWMABN=0 Q 10
;---> RETURN THE CDC CODE FOR THE RESULT (PC 25). IF RESULT IS 4,5,
;---> OR 6, SET BWMABN=1 TO EXTRACT DATA FOR ABNORMAL MAM SECTION.
N X S X=$P(^BWDIAG(BWRESN,0),U,25)
S BWMABN=$S(654[X:1,1:0)
Q $J(X,2)
;
MWKUP() ;EP
;---> RETURN THE DX WORKUP: 1=PLANNED, 2=NOT PLANNED, 3=UNDETERMINED.
Q:'BWMAM 2
;Q:'BWMABN 2
N X
S X=$P(BW2,U,20)
Q:X X
Q 2
;
MDT() ;EP
;---> DATE OF THIS MAMMOGRAM.
Q:'BWMAM!'$P(BW0,U,12) ""
N X
S X=$$MRESLT
Q:+X>7 ""
Q:BWMAM $$CDCDT^BWMDE2($P(BW0,U,12))
Q ""
;
MPAY() ;EP
;---> MAM PAID FOR BY COOP AGREEMENT FUNDS, 3=DON'T KNOW.
Q:'BWMAM ""
N X
S X=$$MRESLT
Q:+X>7 ""
Q 1
BDXPAID() ;EP
;---> BREAST DX PAID FOR BY COOP AGREEMENT FUNDS, 3=DON'T KNOW.
Q:'BWMAM ""
N X S X=$$MRESLT
Q:+X>7 ""
Q:BWMAM 1
Q ""
CBEPAID() ;EP
;---> CBE PAID FOR BY COOP AGREEMENT FUNDS, 3=DON'T KNOW.
Q:'BWMAM ""
N X
S X=$$MRESLT
Q:+X>7 ""
Q:BWMAM 1
Q ""
;
CDXPAID() ;EP
;---> CBE PAID FOR BY COOP AGREEMENT FUNDS, 3=DON'T KNOW.
Q:'BWPAP ""
I '$$CONOBX(),'$$COLPBX(),'$$POTHPR() Q ""
Q 1
;
MDEVER() ;EP
;===> ANMC MODS BEGIN, IHS/ANMC/MWRZ 07/17/97
;Q 23
;Q 24 ;IHS/ANMC/MWRZ 07/17/97 ;CHANGE VERSION# FROM 23 TO 24.
;Q 40 ;IHS/CMI/THL 03/25/99 ;CHANGE VERSION# FROM 24 TO 40.
Q 41 ;IHS/CMI/THL CHANGE VERSION# FROM 40 TO 41.
;===> ANMC MODS END, IHS/ANMC/MWRZ 07/17/97
;
CONOBX() ;EP
;---> COLP DONE WITHOUT BIOPSY.
Q:'BWPABN ""
Q:$$PWKUP>1 ""
;---> IF THERE IS AN ASSOCIATED COLP, BWC0=ZERO NODE OF THAT PCD.
Q:BWC0']"" 2
Q:$P(BWC0,U,26)="" 1
Q 2
;
COLPBX() ;EP
;---> COLP DONE WITH BIOPSY.
Q:'BWPABN ""
Q:$$PWKUP>1 ""
;---> IF THERE IS AN ASSOCIATED COLP, BWC0=ZERO NODE OF THAT PCD.
Q:BWC0']"" 2
Q:$P(BWC0,U,26)]"" 1
Q 2
;
POTHPR() ;EP
;---> OTHER PROCEDURES PERFORMED WITH THIS ABNORMAL PAP.
Q:'BWPABN ""
Q:$$PWKUP>1 ""
Q:$P(BW2,U,21)]"" 1
Q 2
;
POTHPR1() ;EP
;---> LIST OTHER PROCEDURES PERFORMED WITH THIS ABNORMAL PAP.
Q:'BWPABN ""
Q:$$PWKUP>1 ""
Q $E($P(BW2,U,21),1,20)
;
POTHPR2() ;EP
Q ""
;
PFNDX() ;EP
;---> FINAL DIAGNOSIS FOR ASSOCIATED COLP.
;---> FIRST TRY TO GET IT FROM #.33 FIELD; IF NOT, TRY ASSOC'D COLP.
Q:'BWPABN ""
Q:$$PWKUP>1 ""
N X S X=$P(BW0,U,33)
S:'X X=$P(BWC0,U,5)
Q:'X ""
Q:'$D(^BWDIAG(X,0)) ""
Q $P(^BWDIAG(X,0),U,26)
;
PSTGDX() ;EP
;---> STAGE AT FINAL DIAGNOSIS. GET FROM ASSOC'D COLP.
Q:'BWPABN ""
Q:$$PWKUP>1 ""
Q:$$PFNDX()'=6 ""
Q $P(BWC0,U,31)
;
PFNDXO() ;EP
;---> FREE TEXT DIAGNOSIS OF "OTHER" FOR ASSOC'D COLP.
Q:'BWPABN ""
Q:$$PWKUP>1 ""
Q:$$PFNDX()'=7 ""
N X S X=$P(BW0,U,33)
S:'X X=$P(BWC0,U,5)
Q:'X ""
Q:'$D(^BWDIAG(X,0)) ""
Q $E($P(^BWDIAG(X,0),U),1,20)
;
PSTFDX() ;EP
;---> PAP STATUS OF FINAL DX.
Q:'BWPABN ""
Q:$$PWKUP>1 ""
Q $P(BW2,U,22)
;
PFDXDT() ;EP
;---> PAP DATE OF FINAL DX.
Q:'BWPABN ""
Q:$$PWKUP>1 ""
Q $$CDCDT^BWMDE2($P(BW2,U,23))
;
PSTTX() ;EP
;---> STATUS OF TX.
Q:'BWPABN ""
Q:$$PWKUP>1 ""
Q $P(BW2,U,24)
;
PSTXDT() ;EP
;---> DATE OF TX STATUS.
Q:'BWPABN ""
Q:$$PWKUP>1 ""
Q $$CDCDT^BWMDE2($P(BW2,U,25))
;
MFUDXV() ;EP
;---> MAM FOLLOWUP DIAGNOSTIC VIEWW.
;Q:'BWMABN ""
;Q:$$MWKUP>1 ""
Q $P(BW2,U,34)
;
MRBREX() ;EP
;---> MAM REPEAT BREAST EXAM.
;Q:'BWMABN ""
;Q:$$MWKUP>1 ""
Q $P(BW2,U,26)
;
MULTRA() ;EP
;---> MAM ULTRASOUND.
;Q:'BWMABN ""
;Q:$$MWKUP>1 ""
Q $P(BW2,U,27)
;
MLUMP() ;EP
;---> MAM BIOPSY/LUMPECTOMY.
;Q:'BWMABN ""
;Q:$$MWKUP>1 ""
Q $P(BW2,U,28)
;
MFINDL() ;EP
;---> MAM FINE NEEDLE/CYST ASPIRATION.
;Q:'BWMABN ""
;Q:$$MWKUP>1 ""
Q $P(BW2,U,29)
;
MOTHPR() ;EP
;---> MAM OTHER PROCEDURES PERFORMED WITH THIS ABNORMAL MAM.
;Q:'BWMABN ""
;Q:$$MWKUP>1 ""
Q:$P(BW2,U,21)]"" 1
Q 2
;
MOTHPR1() ;EP
;---> LIST OTHER PROCEDURES PERFORMED WITH THIS ABNORMAL PAP.
;Q:'BWMABN ""
;Q:$$MWKUP>1 ""
Q:$P(BW2,U,21)]"" $E($P(BW2,U,21),1,20)
Q ""
;
MOTHPR2() ;EP
;---> LIST MORE OTHER PROCEDURES PERFORMED WITH THIS ABNORMAL PAP.
Q ""
;Q:'BWMABN ""
;
MFNDX() ;EP
;---> MAM FINAL DX.
;Q:'BWMABN ""
;Q:$$MWKUP>1 ""
Q $P(BW2,U,30)
;
MSTGDX() ;EP
;---> MAM STAGE AT FINAL DX.
;Q:'BWMABN ""
;Q:$$MWKUP>1 ""
Q $P(BW0,U,31)
;
MTMRSZ() ;EP
;---> MAM TUMOR SIZE.
;Q:'BWMABN ""
;Q:$$MWKUP>1 ""
Q $P(BW2,U,31)
;
MSTFDX() ;EP
;---> MAM STATUS OF FINAL DX.
;Q:'BWMABN ""
;Q:$$MWKUP>1 ""
Q $P(BW2,U,22)
;
MFDXDT() ;EP
;---> MAM DATE OF FINAL DX.
;Q:'BWMABN ""
;Q:$$MWKUP>1 ""
Q:$P(BW2,U,23) $$CDCDT^BWMDE2($P(BW2,U,23))
Q ""
;
MSTTX() ;EP
;---> MAM STATUS OF TX.
;Q:'BWMABN ""
;Q:$$MWKUP>1 ""
Q $P(BW2,U,24)
;
MSTXDT() ;EP
;---> MAM DATE OF TX STATUS.
;Q:'BWMABN ""
;Q:$$MWKUP>1 ""
Q:$P(BW2,U,25) $$CDCDT^BWMDE2($P(BW2,U,25))
Q ""
;
EOR() ;EP
Q ""
;
HRCN() ;
;---> APPEND HEALTH RECORD NUMBER FOR LOCAL PURPOSE.
Q $$HRCN1^BWUTL1(BWDFN,DUZ(2))
PWKUP() ;EP
;---> RETURN THE DX WORKUP: 1=PLANNED, 2=NOT PLANNED, 3=UNDETERMINED.
Q:'BWPAP 2
;IHS/CMI/THL 04/13/99 PATCH 7 TO RETURN CODE 3
Q:$E($G(BWCDC(+$G(BWIEN))),107,108)=11 3
Q:'BWPABN 2
N X S X=$P(BW2,U,20)
Q:(BWPAP&(X)) X
Q 2
;
BWMDE21 ;IHS/ANMC/MWR - MDE FUNCTIONS. BWMDE2 CON'T;15-Feb-2003 21:58;PLS
+1 ;;2.0;WOMEN'S HEALTH;**5,7,8**;MAY 16, 1996
+2 ;;Modified for Y2K compliance THL/HJT 5/14/99
+3 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
+4 ;; CDC EXPORT, FUNCTIONS TO RETRIEVE DATA FOR INDIVIDUAL FIELDS
+5 ;; FOR EXPORT.
+6 ;
+7 ;IHS/CMI/THL - CONTINUATION OF BWMDE2 - PATCH 7
+8 ;
MPREV() ;EP
+1 ;---> BUILD BW("MAM") ARRAY OF PREVIOUS MAMS. RETURN 3 IF NONE.
+2 IF 'BWMAM
QUIT 3
+3 NEW N,Y
KILL BW("MAM")
SET N=0
+4 FOR
SET N=$ORDER(^BWPCD("C",BWDFN,N))
IF 'N
QUIT
Begin DoDot:1
+5 SET Y=^BWPCD(N,0)
+6 IF $$PMAM^BWUTL6(+$PIECE(Y,U,4))
Begin DoDot:2
+7 SET BWMAMDT=$PIECE(Y,U,12)
+8 IF BWMAMDT'<$PIECE(BW0,U,12)
QUIT
+9 SET BW("MAM",9999999-BWMAMDT)=BWMAMDT
End DoDot:2
End DoDot:1
+10 IF $DATA(BW("MAM"))
QUIT 1
+11 QUIT 3
+12 ;
MPREVDT() ;EP
+1 ;---> USE ABOVE BW("MAM") ARRAY TO RETURN DATE OF PREVIOUS MAM.
+2 IF 'BWMAM
QUIT ""
+3 IF '$DATA(BW("MAM"))
QUIT ""
+4 NEW N
+5 SET N=$ORDER(BW("MAM",0))
+6 ;Begin Y2k fix
+7 ;I N S N=BW("MAM",N) K BW("MAM") Q $E(N,4,5)_$E(N,2,3)
+8 ;
+9 ;MOD PER THL 03/25/99 FOR CDC V4.0 AND Y2K COMPLIANCE
+10 ;
+11 ;Y2000
IF N
SET N=BW("MAM",N)
KILL BW("MAM")
QUIT $EXTRACT(N,4,5)_($EXTRACT(N,1,3)+1700)
+12 ;
+13 ;END MOD PER THL 03/25/99 FOR CDC V4.0 AND Y2K COMPLIANCE
+14 ;End Y2k fix
+15 ;
+16 QUIT ""
+17 ;
MRESLT() ;EP
+1 ;---> IF THIS PCD IS NOT MAM:
+2 ;---> RETURN 9 IF BR TX NEED=MAM AND DUE DATE IS BEFORE TODAY.
+3 ;---> RETURN 8 IF BR TX NEED'=MAM, OR IF BR TX NEED=MAM BUT DUE DATE
+4 ;---> IS AFTER TODAY.
+5 ;---> BOTH CASES SET BWMABN=0 (ABNORMAL MAM=0).
+6 ;---> (BWMABN=0 WILL BLANK FILL ALL DATA IN ABNORMAL MAM SECTION.)
+7 ;
+8 IF 'BWMAM
SET BWMABN=0
QUIT " 8"
+9 ;---> THIS PROCEDURE MUST BE A MAM.
+10 ;---> IF NO RESULT, RETURN 10 (RESULT PENDING) AND SET BWMABN=0.
+11 IF 'BWRESN
SET BWMABN=0
QUIT 10
+12 ;---> RETURN THE CDC CODE FOR THE RESULT (PC 25). IF RESULT IS 4,5,
+13 ;---> OR 6, SET BWMABN=1 TO EXTRACT DATA FOR ABNORMAL MAM SECTION.
+14 NEW X
SET X=$PIECE(^BWDIAG(BWRESN,0),U,25)
+15 SET BWMABN=$SELECT(654[X:1,1:0)
+16 QUIT $JUSTIFY(X,2)
+17 ;
MWKUP() ;EP
+1 ;---> RETURN THE DX WORKUP: 1=PLANNED, 2=NOT PLANNED, 3=UNDETERMINED.
+2 IF 'BWMAM
QUIT 2
+3 ;Q:'BWMABN 2
+4 NEW X
+5 SET X=$PIECE(BW2,U,20)
+6 IF X
QUIT X
+7 QUIT 2
+8 ;
MDT() ;EP
+1 ;---> DATE OF THIS MAMMOGRAM.
+2 IF 'BWMAM!'$PIECE(BW0,U,12)
QUIT ""
+3 NEW X
+4 SET X=$$MRESLT
+5 IF +X>7
QUIT ""
+6 IF BWMAM
QUIT $$CDCDT^BWMDE2($PIECE(BW0,U,12))
+7 QUIT ""
+8 ;
MPAY() ;EP
+1 ;---> MAM PAID FOR BY COOP AGREEMENT FUNDS, 3=DON'T KNOW.
+2 IF 'BWMAM
QUIT ""
+3 NEW X
+4 SET X=$$MRESLT
+5 IF +X>7
QUIT ""
+6 QUIT 1
BDXPAID() ;EP
+1 ;---> BREAST DX PAID FOR BY COOP AGREEMENT FUNDS, 3=DON'T KNOW.
+2 IF 'BWMAM
QUIT ""
+3 NEW X
SET X=$$MRESLT
+4 IF +X>7
QUIT ""
+5 IF BWMAM
QUIT 1
+6 QUIT ""
CBEPAID() ;EP
+1 ;---> CBE PAID FOR BY COOP AGREEMENT FUNDS, 3=DON'T KNOW.
+2 IF 'BWMAM
QUIT ""
+3 NEW X
+4 SET X=$$MRESLT
+5 IF +X>7
QUIT ""
+6 IF BWMAM
QUIT 1
+7 QUIT ""
+8 ;
CDXPAID() ;EP
+1 ;---> CBE PAID FOR BY COOP AGREEMENT FUNDS, 3=DON'T KNOW.
+2 IF 'BWPAP
QUIT ""
+3 IF '$$CONOBX()
IF '$$COLPBX()
IF '$$POTHPR()
QUIT ""
+4 QUIT 1
+5 ;
MDEVER() ;EP
+1 ;===> ANMC MODS BEGIN, IHS/ANMC/MWRZ 07/17/97
+2 ;Q 23
+3 ;Q 24 ;IHS/ANMC/MWRZ 07/17/97 ;CHANGE VERSION# FROM 23 TO 24.
+4 ;Q 40 ;IHS/CMI/THL 03/25/99 ;CHANGE VERSION# FROM 24 TO 40.
+5 ;IHS/CMI/THL CHANGE VERSION# FROM 40 TO 41.
QUIT 41
+6 ;===> ANMC MODS END, IHS/ANMC/MWRZ 07/17/97
+7 ;
CONOBX() ;EP
+1 ;---> COLP DONE WITHOUT BIOPSY.
+2 IF 'BWPABN
QUIT ""
+3 IF $$PWKUP>1
QUIT ""
+4 ;---> IF THERE IS AN ASSOCIATED COLP, BWC0=ZERO NODE OF THAT PCD.
+5 IF BWC0']""
QUIT 2
+6 IF $PIECE(BWC0,U,26)=""
QUIT 1
+7 QUIT 2
+8 ;
COLPBX() ;EP
+1 ;---> COLP DONE WITH BIOPSY.
+2 IF 'BWPABN
QUIT ""
+3 IF $$PWKUP>1
QUIT ""
+4 ;---> IF THERE IS AN ASSOCIATED COLP, BWC0=ZERO NODE OF THAT PCD.
+5 IF BWC0']""
QUIT 2
+6 IF $PIECE(BWC0,U,26)]""
QUIT 1
+7 QUIT 2
+8 ;
POTHPR() ;EP
+1 ;---> OTHER PROCEDURES PERFORMED WITH THIS ABNORMAL PAP.
+2 IF 'BWPABN
QUIT ""
+3 IF $$PWKUP>1
QUIT ""
+4 IF $PIECE(BW2,U,21)]""
QUIT 1
+5 QUIT 2
+6 ;
POTHPR1() ;EP
+1 ;---> LIST OTHER PROCEDURES PERFORMED WITH THIS ABNORMAL PAP.
+2 IF 'BWPABN
QUIT ""
+3 IF $$PWKUP>1
QUIT ""
+4 QUIT $EXTRACT($PIECE(BW2,U,21),1,20)
+5 ;
POTHPR2() ;EP
+1 QUIT ""
+2 ;
PFNDX() ;EP
+1 ;---> FINAL DIAGNOSIS FOR ASSOCIATED COLP.
+2 ;---> FIRST TRY TO GET IT FROM #.33 FIELD; IF NOT, TRY ASSOC'D COLP.
+3 IF 'BWPABN
QUIT ""
+4 IF $$PWKUP>1
QUIT ""
+5 NEW X
SET X=$PIECE(BW0,U,33)
+6 IF 'X
SET X=$PIECE(BWC0,U,5)
+7 IF 'X
QUIT ""
+8 IF '$DATA(^BWDIAG(X,0))
QUIT ""
+9 QUIT $PIECE(^BWDIAG(X,0),U,26)
+10 ;
PSTGDX() ;EP
+1 ;---> STAGE AT FINAL DIAGNOSIS. GET FROM ASSOC'D COLP.
+2 IF 'BWPABN
QUIT ""
+3 IF $$PWKUP>1
QUIT ""
+4 IF $$PFNDX()'=6
QUIT ""
+5 QUIT $PIECE(BWC0,U,31)
+6 ;
PFNDXO() ;EP
+1 ;---> FREE TEXT DIAGNOSIS OF "OTHER" FOR ASSOC'D COLP.
+2 IF 'BWPABN
QUIT ""
+3 IF $$PWKUP>1
QUIT ""
+4 IF $$PFNDX()'=7
QUIT ""
+5 NEW X
SET X=$PIECE(BW0,U,33)
+6 IF 'X
SET X=$PIECE(BWC0,U,5)
+7 IF 'X
QUIT ""
+8 IF '$DATA(^BWDIAG(X,0))
QUIT ""
+9 QUIT $EXTRACT($PIECE(^BWDIAG(X,0),U),1,20)
+10 ;
PSTFDX() ;EP
+1 ;---> PAP STATUS OF FINAL DX.
+2 IF 'BWPABN
QUIT ""
+3 IF $$PWKUP>1
QUIT ""
+4 QUIT $PIECE(BW2,U,22)
+5 ;
PFDXDT() ;EP
+1 ;---> PAP DATE OF FINAL DX.
+2 IF 'BWPABN
QUIT ""
+3 IF $$PWKUP>1
QUIT ""
+4 QUIT $$CDCDT^BWMDE2($PIECE(BW2,U,23))
+5 ;
PSTTX() ;EP
+1 ;---> STATUS OF TX.
+2 IF 'BWPABN
QUIT ""
+3 IF $$PWKUP>1
QUIT ""
+4 QUIT $PIECE(BW2,U,24)
+5 ;
PSTXDT() ;EP
+1 ;---> DATE OF TX STATUS.
+2 IF 'BWPABN
QUIT ""
+3 IF $$PWKUP>1
QUIT ""
+4 QUIT $$CDCDT^BWMDE2($PIECE(BW2,U,25))
+5 ;
MFUDXV() ;EP
+1 ;---> MAM FOLLOWUP DIAGNOSTIC VIEWW.
+2 ;Q:'BWMABN ""
+3 ;Q:$$MWKUP>1 ""
+4 QUIT $PIECE(BW2,U,34)
+5 ;
MRBREX() ;EP
+1 ;---> MAM REPEAT BREAST EXAM.
+2 ;Q:'BWMABN ""
+3 ;Q:$$MWKUP>1 ""
+4 QUIT $PIECE(BW2,U,26)
+5 ;
MULTRA() ;EP
+1 ;---> MAM ULTRASOUND.
+2 ;Q:'BWMABN ""
+3 ;Q:$$MWKUP>1 ""
+4 QUIT $PIECE(BW2,U,27)
+5 ;
MLUMP() ;EP
+1 ;---> MAM BIOPSY/LUMPECTOMY.
+2 ;Q:'BWMABN ""
+3 ;Q:$$MWKUP>1 ""
+4 QUIT $PIECE(BW2,U,28)
+5 ;
MFINDL() ;EP
+1 ;---> MAM FINE NEEDLE/CYST ASPIRATION.
+2 ;Q:'BWMABN ""
+3 ;Q:$$MWKUP>1 ""
+4 QUIT $PIECE(BW2,U,29)
+5 ;
MOTHPR() ;EP
+1 ;---> MAM OTHER PROCEDURES PERFORMED WITH THIS ABNORMAL MAM.
+2 ;Q:'BWMABN ""
+3 ;Q:$$MWKUP>1 ""
+4 IF $PIECE(BW2,U,21)]""
QUIT 1
+5 QUIT 2
+6 ;
MOTHPR1() ;EP
+1 ;---> LIST OTHER PROCEDURES PERFORMED WITH THIS ABNORMAL PAP.
+2 ;Q:'BWMABN ""
+3 ;Q:$$MWKUP>1 ""
+4 IF $PIECE(BW2,U,21)]""
QUIT $EXTRACT($PIECE(BW2,U,21),1,20)
+5 QUIT ""
+6 ;
MOTHPR2() ;EP
+1 ;---> LIST MORE OTHER PROCEDURES PERFORMED WITH THIS ABNORMAL PAP.
+2 QUIT ""
+3 ;Q:'BWMABN ""
+4 ;
MFNDX() ;EP
+1 ;---> MAM FINAL DX.
+2 ;Q:'BWMABN ""
+3 ;Q:$$MWKUP>1 ""
+4 QUIT $PIECE(BW2,U,30)
+5 ;
MSTGDX() ;EP
+1 ;---> MAM STAGE AT FINAL DX.
+2 ;Q:'BWMABN ""
+3 ;Q:$$MWKUP>1 ""
+4 QUIT $PIECE(BW0,U,31)
+5 ;
MTMRSZ() ;EP
+1 ;---> MAM TUMOR SIZE.
+2 ;Q:'BWMABN ""
+3 ;Q:$$MWKUP>1 ""
+4 QUIT $PIECE(BW2,U,31)
+5 ;
MSTFDX() ;EP
+1 ;---> MAM STATUS OF FINAL DX.
+2 ;Q:'BWMABN ""
+3 ;Q:$$MWKUP>1 ""
+4 QUIT $PIECE(BW2,U,22)
+5 ;
MFDXDT() ;EP
+1 ;---> MAM DATE OF FINAL DX.
+2 ;Q:'BWMABN ""
+3 ;Q:$$MWKUP>1 ""
+4 IF $PIECE(BW2,U,23)
QUIT $$CDCDT^BWMDE2($PIECE(BW2,U,23))
+5 QUIT ""
+6 ;
MSTTX() ;EP
+1 ;---> MAM STATUS OF TX.
+2 ;Q:'BWMABN ""
+3 ;Q:$$MWKUP>1 ""
+4 QUIT $PIECE(BW2,U,24)
+5 ;
MSTXDT() ;EP
+1 ;---> MAM DATE OF TX STATUS.
+2 ;Q:'BWMABN ""
+3 ;Q:$$MWKUP>1 ""
+4 IF $PIECE(BW2,U,25)
QUIT $$CDCDT^BWMDE2($PIECE(BW2,U,25))
+5 QUIT ""
+6 ;
EOR() ;EP
+1 QUIT ""
+2 ;
HRCN() ;
+1 ;---> APPEND HEALTH RECORD NUMBER FOR LOCAL PURPOSE.
+2 QUIT $$HRCN1^BWUTL1(BWDFN,DUZ(2))
PWKUP() ;EP
+1 ;---> RETURN THE DX WORKUP: 1=PLANNED, 2=NOT PLANNED, 3=UNDETERMINED.
+2 IF 'BWPAP
QUIT 2
+3 ;IHS/CMI/THL 04/13/99 PATCH 7 TO RETURN CODE 3
+4 IF $EXTRACT($GET(BWCDC(+$GET(BWIEN))),107,108)=11
QUIT 3
+5 IF 'BWPABN
QUIT 2
+6 NEW X
SET X=$PIECE(BW2,U,20)
+7 IF (BWPAP&(X))
QUIT X
+8 QUIT 2
+9 ;
