BWPTCH11 ;IHS/CMI/LAB - BW PATCH 11 ;6-Jan-2009 12:14;PLS
;;2.0;WOMEN'S HEALTH;**11**;MAY 16, 1996
;
;
PRE ;
S DIU=9002086.34,DIU(0)="" D EN^DIU2
Q
POST ;
; Add version 6.0 to the MDE multiple in the race mappings file.
N BWRIEN,BWCODE,BWSITE,DR,BWREC,BWDAT,BWNEWDX,BWUSEDX,BWUIEN,BWDX0,NBWDX0,J,NEWIEN,I,BWPIEN
I $$PATCH^XPDUTL("BW*2.0*11") W "POST INSTALL WILL NOT RUN AGAIN" Q
S BWRIEN=0 F S BWRIEN=$O(^BWRACE(BWRIEN)) Q:'BWRIEN D
.I $D(^BWRACE(BWRIEN,1,"AC",50)) D
..S BWCODE=$O(^BWRACE(BWRIEN,1,"AC",50,0)) Q:'BWCODE
..S FDA(9002086.341,"+1,"_BWRIEN_",",.01)=60 D UPDATE^DIE(,"FDA","NEWIEN") K FDA
..I $D(NEWIEN) D
...S FDA(9002086.341,NEWIEN(1)_","_BWRIEN_",",1)=BWCODE D FILE^DIE(,"FDA") K NEWIEN,FDA
;
; Add 6.0 to the MDE Version multiple in the BW SITE PARAMETER file.
S BWSITE=0 F S BWSITE=$O(^BWSITE(BWSITE)) Q:'BWSITE D
.;I $$GET1^DIQ(9002086.02,BWSITE,.18,"I")'=50 Q
.S DR=".18///"_60 D DIE^BWFMAN(9002086.02,DR,BWSITE,.BWPOP)
;
; Update the BW RESULTS/DIAGNOSIS file with new BI-RAD codes.
P2 F I=25,26,28 D CLN(I)
F I=1:1 D Q:BWREC=" Q"
.S BWREC=$T(DIAG+I) Q:'$L(BWREC)
.S BWDAT=$P(BWREC,";;",2)
.S BWNEWDX=$P(BWDAT,":"),BWUSEDX=$P(BWDAT,":",2),BWDXPRCS=$P(BWDAT,":",3) Q:BWNEWDX=""
.; If the new DX already exists, do not create another entry. Update the existing entry
.; to be sure that the data in the entry is correct.
.I $D(^BWDIAG("B",BWNEWDX)) D Q
..S BWPIEN=$O(^BWDIAG("B",BWNEWDX,0))
..D ADDPRCS(BWDXPRCS,.BWDX0)
..S $P(^BWDIAG(BWPIEN,0),U,3)=BWDX0
..S $P(^BWDIAG(BWPIEN,0),U,20)=0
..S $P(^BWDIAG(BWPIEN,0),U,25)=$P(BWDAT,":",5)
..D REINDEX(BWPIEN)
.I BWUSEDX="" D Q
..S BWDX0=""
..S FDA(9002086.31,"+1,",.01)=BWNEWDX
..S FDA(9002086.31,"+1,",.02)=$P(BWDAT,":",4) D UPDATE^DIE(,"FDA","NEWIEN") K FDA
..I $D(NEWIEN) D
...D ADDPRCS(BWDXPRCS,.BWDX0)
...S $P(^BWDIAG(NEWIEN(1),0),U,3)=BWDX0
...S $P(^BWDIAG(NEWIEN(1),0),U,20)=0
...S $P(^BWDIAG(NEWIEN(1),0),U,25)=$P(BWDAT,":",5)
...S DIK="^BWDIAG(",DA=NEWIEN(1) D IX^DIK K NEWIEN
.S BWUIEN=$O(^BWDIAG("B",BWUSEDX,0)) Q:'BWUIEN
.S BWPRI=$P(^BWDIAG(BWUIEN,0),U,2)
.S BWDX0=$P(^BWDIAG(BWUIEN,0),U,3,99)
.S BWPRC=""
.D ADDPRCS(BWDXPRCS,.BWDX0)
.S FDA(9002086.31,"+1,",.01)=BWNEWDX
.S FDA(9002086.31,"+1,",.02)=BWPRI
.D UPDATE^DIE(,"FDA","NEWIEN") K FDA
.I $D(NEWIEN) D
..S $P(^BWDIAG(NEWIEN(1),0),U,3)=BWDX0
.D REINDEX(NEWIEN(1))
.D REINDEX(BWUIEN)
.K BWDX0,NEWIEN,DIK,DA
D UPDHPV
K ^BWDIAG("P")
S DIK="^BWDIAG(" D IXALL^DIK
Q
; Add CDC Equiv. HPV results. If the result type already exists, just update the new field value.
REINDEX(IEN) ;
S DIK="^BWDIAG(",DA=IEN D IX^DIK
Q
UPDHPV ;
N I,DATA,RESDAT,RES,CDCVAL,PRIO,DR,FDA
D CLN(40)
F I=1:1 D Q:DATA=" Q"
.S DATA=$T(HPV+I) Q:DATA=" Q"
.S RESDAT=$P(DATA,";;",2) Q:RESDAT=""
.S RES=$P(RESDAT,":"),CDCVAL=$P(RESDAT,":",2),PRIO=$P(RESDAT,":",3)
.I $D(^BWDIAG("B",RES)) D Q
..S RESIEN=$O(^BWDIAG("B",RES,0))
..S DR="1///"_CDCVAL D DIE^BWFMAN(9002086.31,DR,RESIEN,.BWPOP)
..D ADDHPV(RESIEN)
..S DIK="^BWDIAG(",DA=RESIEN D IX^DIK
.S FDA(9002086.31,"+1,",.01)=RES
.S FDA(9002086.31,"+1,",.02)=PRIO
.S FDA(9002086.31,"+1,",1)=CDCVAL
.D UPDATE^DIE(,"FDA","NEWIEN") K FDA
.I '$D(NEWIEN) Q
.S RESIEN=$G(NEWIEN(1))
.D ADDHPV(RESIEN)
.S DIK="^BWDIAG(",DA=RESIEN D IX^DIK
.K NEWIEN
Q
; Clean up old entries with pointers to value passed in.
; INPUT : PRIEN - The value pointed to by the ASSOCIATED PROCEDURE portion of the BW RESULT/DIAGNOSIS file.
CLN(PRIEN) ;
N BWIEN,I,VAL,J,NODE,DIK,DA,ARY
Q:'PRIEN
S BWIEN=0 F S BWIEN=$O(^BWDIAG(BWIEN)) Q:'BWIEN D
.K ARY
.F I=3:1:19 D
..S VAL=$P(^BWDIAG(BWIEN,0),U,I) I VAL S ARY(VAL)=""
.I '$D(ARY(PRIEN)) Q
.F I=3:1:19 S $P(^BWDIAG(BWIEN,0),U,I)=""
.K ARY(PRIEN) I '$O(ARY(0)) Q
.S NODE=3
.S J=0 F S J=$O(ARY(J)) Q:'J D
..S $P(^BWDIAG(BWIEN,0),U,NODE)=J,NODE=NODE+1
.;S DIK="^BWDIAG(",DA=BWIEN D IX^DIK
Q
; Add HPV procedure to this diagnosis
ADDHPV(RESIEN) ;
N I,VAL,DONE,SETPC
S (DONE,SETPC)=0
F I=3:1:19 D Q:DONE
.S VAL=$P(^BWDIAG(RESIEN,0),U,I)
.I VAL=$O(^BWPN("B","HPV SCREEN",0)) S DONE=1 Q
.I 'VAL S DONE=1,SETPC=I Q
Q:'SETPC
S $P(^BWDIAG(RESIEN,0),U,SETPC)=$O(^BWPN("B","HPV SCREEN",0))
Q
; Add procedures to new code
ADDPRCS(BWDXPRCS,BWDX0) ;
N J,PC,BWPRC,DONE
S BWPRC=""
F J=1:1:17 D Q:BWPRC=""
.S BWPRC=$P(BWDXPRCS,",",J) Q:BWPRC=""
.S BWPRCIEN=$O(^BWPN("B",BWPRC,0))
.S $P(BWDX0,U,J)=BWPRCIEN
; find the first blank entry and add IEN for VAGINAL ULTRASOUND
S DONE=0
F K=1:1:17 D Q:DONE
.; If this is already part of the BU result set, quit.
.I $P(BWDX0,U,K)=$O(^BWPN("B","BREAST ULTRASOUND",0)) S DONE=1 Q
.I $P(BWDX0,U,K) Q
.S $P(BWDX0,U,K)=$O(^BWPN("B","BREAST ULTRASOUND",0)),DONE=1
Q
; Remove procedure from old code
REMPRCS(BWDXPRCS,BWUIEN) ;
N I,ARY,BWPRC,BWPRCIEN,A,TARY,PIECE,ITEM,LOOP
; build array of items to be removed
F A=1:1:17 D Q:BWPRC=""
.S BWPRC=$P(BWDXPRCS,",",A) Q:BWPRC=""
.S BWPRCIEN=$O(^BWPN("B",BWPRC,0))
.S TARY(BWPRCIEN)=""
; build array of items currently defined for the result/diagnosis and remove all items from this result/diagnosis
F I=3:1:19 D
.S VAL=$P(^BWDIAG(BWUIEN,0),U,I) Q:'VAL
.S ARY(I)=VAL,$P(^BWDIAG(BWUIEN,0),U,I)="" S DIK="^BWDIAG(",DA=BWUIEN D IX2^DIK Q
; put the diagnosis items back in, but if the ARY contains one of the values in TARY, skip it, as this is to be removed.
S PIECE=3
S LOOP=0 F S LOOP=$O(ARY(LOOP)) Q:'LOOP D
.S ITEM=$G(ARY(LOOP))
.I $D(TARY(ITEM)) Q
.S $P(^BWDIAG(BWUIEN,0),U,PIECE)=$G(ARY(LOOP))
.S PIECE=PIECE+1
Q
DIAG ;
;;BI-RADS 0-Add Imag Eval Needed::MAMMOGRAM DX BILAT,MAMMOGRAM DX UNILAT,MAMMOGRAM SCREENING:6:13
;;BI-RADS 1:Negative:MAMMOGRAM DX BILAT,MAMMOGRAM DX UNILAT,MAMMOGRAM SCREENING
;;BI-RADS 2:Benign Finding, Negative:MAMMOGRAM DX BILAT,MAMMOGRAM DX UNILAT,MAMMOGRAM SCREENING
;;BI-RADS 3:Prbly Benign, Short Int F/U:MAMMOGRAM DX BILAT,MAMMOGRAM DX UNILAT,MAMMOGRAM SCREENING
;;BI-RADS 4:Suspicious Abnorm, Consider Bx:MAMMOGRAM DX BILAT,MAMMOGRAM DX UNILAT,MAMMOGRAM SCREENING
;;BI-RADS 5:Highly Sug of Malig, Tk Action:MAMMOGRAM DX BILAT,MAMMOGRAM DX UNILAT,MAMMOGRAM SCREENING
;;BI-RADS 0-Prev Films Req:Incomplete, Previous Films Req:MAMMOGRAM DX BILAT,MAMMOGRAM DX UNILAT,MAMMOGRAM SCREENING:7
Q
HPV ;
;;Positive:1:10
;;Negative:2:20
;;Test Not Done:3:30
;;Unknown:9:90
Q
BWPTCH11 ;IHS/CMI/LAB - BW PATCH 11 ;6-Jan-2009 12:14;PLS
+1 ;;2.0;WOMEN'S HEALTH;**11**;MAY 16, 1996
+2 ;
+3 ;
PRE ;
+1 SET DIU=9002086.34
SET DIU(0)=""
DO EN^DIU2
+2 QUIT
POST ;
+1 ; Add version 6.0 to the MDE multiple in the race mappings file.
+2 NEW BWRIEN,BWCODE,BWSITE,DR,BWREC,BWDAT,BWNEWDX,BWUSEDX,BWUIEN,BWDX0,NBWDX0,J,NEWIEN,I,BWPIEN
+3 IF $$PATCH^XPDUTL("BW*2.0*11")
WRITE "POST INSTALL WILL NOT RUN AGAIN"
QUIT
+4 SET BWRIEN=0
FOR
SET BWRIEN=$ORDER(^BWRACE(BWRIEN))
IF 'BWRIEN
QUIT
Begin DoDot:1
+5 IF $DATA(^BWRACE(BWRIEN,1,"AC",50))
Begin DoDot:2
+6 SET BWCODE=$ORDER(^BWRACE(BWRIEN,1,"AC",50,0))
IF 'BWCODE
QUIT
+7 SET FDA(9002086.341,"+1,"_BWRIEN_",",.01)=60
DO UPDATE^DIE(,"FDA","NEWIEN")
KILL FDA
+8 IF $DATA(NEWIEN)
Begin DoDot:3
+9 SET FDA(9002086.341,NEWIEN(1)_","_BWRIEN_",",1)=BWCODE
DO FILE^DIE(,"FDA")
KILL NEWIEN,FDA
End DoDot:3
End DoDot:2
End DoDot:1
+10 ;
+11 ; Add 6.0 to the MDE Version multiple in the BW SITE PARAMETER file.
+12 SET BWSITE=0
FOR
SET BWSITE=$ORDER(^BWSITE(BWSITE))
IF 'BWSITE
QUIT
Begin DoDot:1
+13 ;I $$GET1^DIQ(9002086.02,BWSITE,.18,"I")'=50 Q
+14 SET DR=".18///"_60
DO DIE^BWFMAN(9002086.02,DR,BWSITE,.BWPOP)
End DoDot:1
+15 ;
+16 ; Update the BW RESULTS/DIAGNOSIS file with new BI-RAD codes.
P2 FOR I=25,26,28
DO CLN(I)
+1 FOR I=1:1
Begin DoDot:1
+2 SET BWREC=$TEXT(DIAG+I)
IF '$LENGTH(BWREC)
QUIT
+3 SET BWDAT=$PIECE(BWREC,";;",2)
+4 SET BWNEWDX=$PIECE(BWDAT,":")
SET BWUSEDX=$PIECE(BWDAT,":",2)
SET BWDXPRCS=$PIECE(BWDAT,":",3)
IF BWNEWDX=""
QUIT
+5 ; If the new DX already exists, do not create another entry. Update the existing entry
+6 ; to be sure that the data in the entry is correct.
+7 IF $DATA(^BWDIAG("B",BWNEWDX))
Begin DoDot:2
+8 SET BWPIEN=$ORDER(^BWDIAG("B",BWNEWDX,0))
+9 DO ADDPRCS(BWDXPRCS,.BWDX0)
+10 SET $PIECE(^BWDIAG(BWPIEN,0),U,3)=BWDX0
+11 SET $PIECE(^BWDIAG(BWPIEN,0),U,20)=0
+12 SET $PIECE(^BWDIAG(BWPIEN,0),U,25)=$PIECE(BWDAT,":",5)
+13 DO REINDEX(BWPIEN)
End DoDot:2
QUIT
+14 IF BWUSEDX=""
Begin DoDot:2
+15 SET BWDX0=""
+16 SET FDA(9002086.31,"+1,",.01)=BWNEWDX
+17 SET FDA(9002086.31,"+1,",.02)=$PIECE(BWDAT,":",4)
DO UPDATE^DIE(,"FDA","NEWIEN")
KILL FDA
+18 IF $DATA(NEWIEN)
Begin DoDot:3
+19 DO ADDPRCS(BWDXPRCS,.BWDX0)
+20 SET $PIECE(^BWDIAG(NEWIEN(1),0),U,3)=BWDX0
+21 SET $PIECE(^BWDIAG(NEWIEN(1),0),U,20)=0
+22 SET $PIECE(^BWDIAG(NEWIEN(1),0),U,25)=$PIECE(BWDAT,":",5)
+23 SET DIK="^BWDIAG("
SET DA=NEWIEN(1)
DO IX^DIK
KILL NEWIEN
End DoDot:3
End DoDot:2
QUIT
+24 SET BWUIEN=$ORDER(^BWDIAG("B",BWUSEDX,0))
IF 'BWUIEN
QUIT
+25 SET BWPRI=$PIECE(^BWDIAG(BWUIEN,0),U,2)
+26 SET BWDX0=$PIECE(^BWDIAG(BWUIEN,0),U,3,99)
+27 SET BWPRC=""
+28 DO ADDPRCS(BWDXPRCS,.BWDX0)
+29 SET FDA(9002086.31,"+1,",.01)=BWNEWDX
+30 SET FDA(9002086.31,"+1,",.02)=BWPRI
+31 DO UPDATE^DIE(,"FDA","NEWIEN")
KILL FDA
+32 IF $DATA(NEWIEN)
Begin DoDot:2
+33 SET $PIECE(^BWDIAG(NEWIEN(1),0),U,3)=BWDX0
End DoDot:2
+34 DO REINDEX(NEWIEN(1))
+35 DO REINDEX(BWUIEN)
+36 KILL BWDX0,NEWIEN,DIK,DA
End DoDot:1
IF BWREC=" Q"
QUIT
+37 DO UPDHPV
+38 KILL ^BWDIAG("P")
+39 SET DIK="^BWDIAG("
DO IXALL^DIK
+40 QUIT
+41 ; Add CDC Equiv. HPV results. If the result type already exists, just update the new field value.
REINDEX(IEN) ;
+1 SET DIK="^BWDIAG("
SET DA=IEN
DO IX^DIK
+2 QUIT
UPDHPV ;
+1 NEW I,DATA,RESDAT,RES,CDCVAL,PRIO,DR,FDA
+2 DO CLN(40)
+3 FOR I=1:1
Begin DoDot:1
+4 SET DATA=$TEXT(HPV+I)
IF DATA=" Q"
QUIT
+5 SET RESDAT=$PIECE(DATA,";;",2)
IF RESDAT=""
QUIT
+6 SET RES=$PIECE(RESDAT,":")
SET CDCVAL=$PIECE(RESDAT,":",2)
SET PRIO=$PIECE(RESDAT,":",3)
+7 IF $DATA(^BWDIAG("B",RES))
Begin DoDot:2
+8 SET RESIEN=$ORDER(^BWDIAG("B",RES,0))
+9 SET DR="1///"_CDCVAL
DO DIE^BWFMAN(9002086.31,DR,RESIEN,.BWPOP)
+10 DO ADDHPV(RESIEN)
+11 SET DIK="^BWDIAG("
SET DA=RESIEN
DO IX^DIK
End DoDot:2
QUIT
+12 SET FDA(9002086.31,"+1,",.01)=RES
+13 SET FDA(9002086.31,"+1,",.02)=PRIO
+14 SET FDA(9002086.31,"+1,",1)=CDCVAL
+15 DO UPDATE^DIE(,"FDA","NEWIEN")
KILL FDA
+16 IF '$DATA(NEWIEN)
QUIT
+17 SET RESIEN=$GET(NEWIEN(1))
+18 DO ADDHPV(RESIEN)
+19 SET DIK="^BWDIAG("
SET DA=RESIEN
DO IX^DIK
+20 KILL NEWIEN
End DoDot:1
IF DATA=" Q"
QUIT
+21 QUIT
+22 ; Clean up old entries with pointers to value passed in.
+23 ; INPUT : PRIEN - The value pointed to by the ASSOCIATED PROCEDURE portion of the BW RESULT/DIAGNOSIS file.
CLN(PRIEN) ;
+1 NEW BWIEN,I,VAL,J,NODE,DIK,DA,ARY
+2 IF 'PRIEN
QUIT
+3 SET BWIEN=0
FOR
SET BWIEN=$ORDER(^BWDIAG(BWIEN))
IF 'BWIEN
QUIT
Begin DoDot:1
+4 KILL ARY
+5 FOR I=3:1:19
Begin DoDot:2
+6 SET VAL=$PIECE(^BWDIAG(BWIEN,0),U,I)
IF VAL
SET ARY(VAL)=""
End DoDot:2
+7 IF '$DATA(ARY(PRIEN))
QUIT
+8 FOR I=3:1:19
SET $PIECE(^BWDIAG(BWIEN,0),U,I)=""
+9 KILL ARY(PRIEN)
IF '$ORDER(ARY(0))
QUIT
+10 SET NODE=3
+11 SET J=0
FOR
SET J=$ORDER(ARY(J))
IF 'J
QUIT
Begin DoDot:2
+12 SET $PIECE(^BWDIAG(BWIEN,0),U,NODE)=J
SET NODE=NODE+1
End DoDot:2
+13 ;S DIK="^BWDIAG(",DA=BWIEN D IX^DIK
End DoDot:1
+14 QUIT
+15 ; Add HPV procedure to this diagnosis
ADDHPV(RESIEN) ;
+1 NEW I,VAL,DONE,SETPC
+2 SET (DONE,SETPC)=0
+3 FOR I=3:1:19
Begin DoDot:1
+4 SET VAL=$PIECE(^BWDIAG(RESIEN,0),U,I)
+5 IF VAL=$ORDER(^BWPN("B","HPV SCREEN",0))
SET DONE=1
QUIT
+6 IF 'VAL
SET DONE=1
SET SETPC=I
QUIT
End DoDot:1
IF DONE
QUIT
+7 IF 'SETPC
QUIT
+8 SET $PIECE(^BWDIAG(RESIEN,0),U,SETPC)=$ORDER(^BWPN("B","HPV SCREEN",0))
+9 QUIT
+10 ; Add procedures to new code
ADDPRCS(BWDXPRCS,BWDX0) ;
+1 NEW J,PC,BWPRC,DONE
+2 SET BWPRC=""
+3 FOR J=1:1:17
Begin DoDot:1
+4 SET BWPRC=$PIECE(BWDXPRCS,",",J)
IF BWPRC=""
QUIT
+5 SET BWPRCIEN=$ORDER(^BWPN("B",BWPRC,0))
+6 SET $PIECE(BWDX0,U,J)=BWPRCIEN
End DoDot:1
IF BWPRC=""
QUIT
+7 ; find the first blank entry and add IEN for VAGINAL ULTRASOUND
+8 SET DONE=0
+9 FOR K=1:1:17
Begin DoDot:1
+10 ; If this is already part of the BU result set, quit.
+11 IF $PIECE(BWDX0,U,K)=$ORDER(^BWPN("B","BREAST ULTRASOUND",0))
SET DONE=1
QUIT
+12 IF $PIECE(BWDX0,U,K)
QUIT
+13 SET $PIECE(BWDX0,U,K)=$ORDER(^BWPN("B","BREAST ULTRASOUND",0))
SET DONE=1
End DoDot:1
IF DONE
QUIT
+14 QUIT
+15 ; Remove procedure from old code
REMPRCS(BWDXPRCS,BWUIEN) ;
+1 NEW I,ARY,BWPRC,BWPRCIEN,A,TARY,PIECE,ITEM,LOOP
+2 ; build array of items to be removed
+3 FOR A=1:1:17
Begin DoDot:1
+4 SET BWPRC=$PIECE(BWDXPRCS,",",A)
IF BWPRC=""
QUIT
+5 SET BWPRCIEN=$ORDER(^BWPN("B",BWPRC,0))
+6 SET TARY(BWPRCIEN)=""
End DoDot:1
IF BWPRC=""
QUIT
+7 ; build array of items currently defined for the result/diagnosis and remove all items from this result/diagnosis
+8 FOR I=3:1:19
Begin DoDot:1
+9 SET VAL=$PIECE(^BWDIAG(BWUIEN,0),U,I)
IF 'VAL
QUIT
+10 SET ARY(I)=VAL
SET $PIECE(^BWDIAG(BWUIEN,0),U,I)=""
SET DIK="^BWDIAG("
SET DA=BWUIEN
DO IX2^DIK
QUIT
End DoDot:1
+11 ; put the diagnosis items back in, but if the ARY contains one of the values in TARY, skip it, as this is to be removed.
+12 SET PIECE=3
+13 SET LOOP=0
FOR
SET LOOP=$ORDER(ARY(LOOP))
IF 'LOOP
QUIT
Begin DoDot:1
+14 SET ITEM=$GET(ARY(LOOP))
+15 IF $DATA(TARY(ITEM))
QUIT
+16 SET $PIECE(^BWDIAG(BWUIEN,0),U,PIECE)=$GET(ARY(LOOP))
+17 SET PIECE=PIECE+1
End DoDot:1
+18 QUIT
DIAG ;
+1 ;;BI-RADS 0-Add Imag Eval Needed::MAMMOGRAM DX BILAT,MAMMOGRAM DX UNILAT,MAMMOGRAM SCREENING:6:13
+2 ;;BI-RADS 1:Negative:MAMMOGRAM DX BILAT,MAMMOGRAM DX UNILAT,MAMMOGRAM SCREENING
+3 ;;BI-RADS 2:Benign Finding, Negative:MAMMOGRAM DX BILAT,MAMMOGRAM DX UNILAT,MAMMOGRAM SCREENING
+4 ;;BI-RADS 3:Prbly Benign, Short Int F/U:MAMMOGRAM DX BILAT,MAMMOGRAM DX UNILAT,MAMMOGRAM SCREENING
+5 ;;BI-RADS 4:Suspicious Abnorm, Consider Bx:MAMMOGRAM DX BILAT,MAMMOGRAM DX UNILAT,MAMMOGRAM SCREENING
+6 ;;BI-RADS 5:Highly Sug of Malig, Tk Action:MAMMOGRAM DX BILAT,MAMMOGRAM DX UNILAT,MAMMOGRAM SCREENING
+7 ;;BI-RADS 0-Prev Films Req:Incomplete, Previous Films Req:MAMMOGRAM DX BILAT,MAMMOGRAM DX UNILAT,MAMMOGRAM SCREENING:7
+8 QUIT
HPV ;
+1 ;;Positive:1:10
+2 ;;Negative:2:20
+3 ;;Test Not Done:3:30
+4 ;;Unknown:9:90
+5 QUIT
