WV1024P ;ISP/RFR - PATCH 24 INSTALLATION TASKS;03/25/2020
;;1.0;WOMEN'S HEALTH;**24**;Sep 30, 1998;Build 582
I '$$PATCH^XPDUTL("WV*1.0*24") D
.N X
.F X=42,45,46,47 D
..I $P($G(^WV(790.2,X,0)),U)'="" D
...W !,"WV Procedure Type entry found at IEN: "_X S XPDABORT=2
Q
;
PRE ;PRE-INSTALL ACTIONS
D BMES^XPDUTL(" Deleting data dictionaries:")
D MES^XPDUTL(" WV PREGNANCY LOG (#790.05)")
N DIU
S DIU=790.05,DIU(0)="T"
D EN^DIU2
D MES^XPDUTL(" WV CASE MANAGER (#790.01)")
S DIU=790.01,DIU(0)=""
D EN^DIU2
D MES^XPDUTL(" CURRENTLY PREGNANT FIELD (#.13) IN WV PATIENT FILE")
N DIK,DA
S DIK="^DD(790,",DA=.13,DA(1)=790
D ^DIK
D MES^XPDUTL(" EDC FIELD (#.14) IN WV PATIENT FILE")
S DIK="^DD(790,",DA=.14,DA(1)=790
D ^DIK
D MES^XPDUTL(" Finished deleting data dictionaries")
I $$LKOPT^XPDMENU("WV EDIT PREGNANCY LOG")>0 D
.D BMES^XPDUTL(" Renaming option WV EDIT PREGNANCY LOG")
.D RENAME^XPDMENU("WV EDIT PREGNANCY LOG","WV EDIT PREG/LAC STATUS DATA")
.D MES^XPDUTL(" Finished renaming option WV EDIT PREGNANCY LOG")
N WVMSGS,WVSTAT
S WVMSGS(1)=" "
S WVMSGS(2)=" Removing the Transfer a Case Manager's Patients option"
S WVMSGS(3)=" from the FILE MAINTENANCE MENU"
D BMES^XPDUTL(.WVMSGS)
S WVSTAT=$$DELETE^XPDMENU("WV MENU-FILE MAINTENANCE","WV TRANSFER CASE MANAGER")
I WVSTAT D MES^XPDUTL(" Option successfully removed")
I 'WVSTAT D MES^XPDUTL(" Option not removed")
D SETMRI,GETACC,GETCOM
D SETBTOMO
Q
;
GETACC ;
N IEN,NODE,SUB
S SUB="WV ACCESS#"
K ^XTMP(SUB)
S ^XTMP(SUB,0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"WV Patch 24 Accession #"
S IEN=$O(^WV(790.2,"B","BREAST MRI","")) Q:IEN'>0
S ^XTMP(SUB,"BREAST MRI")=$P($G(^WV(790.2,IEN,0)),U,6)
Q
;
GETCOM ;
N DA,DIE,DR,CNT,WVIEN,WVXTMP
S WVXTMP="WV COMMENTS CONVERSION"
K ^XTMP(WVXTMP)
S ^XTMP(WVXTMP,0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"WV Patch 24 Comment Conversion"
S WVIEN=0 F S WVIEN=$O(^WV(790.1,WVIEN)) Q:WVIEN'>0 D
.S CNT=0 F S CNT=$O(^WV(790.1,WVIEN,10,CNT)) Q:CNT'>0 D
..I $P($G(^WV(790.1,WVIEN,10,CNT,1)),U)="" Q
..S ^XTMP(WVXTMP,WVIEN,CNT)=$P($G(^WV(790.1,WVIEN,10,CNT,1)),U)
..S DA(1)=WVIEN,DA=CNT
..S DIE="^WV(790.1,"_DA(1)_",10,",DR="3///@" D ^DIE
Q
;
POST ;POST-INSTALL ACTIONS
N WVIEN,WVMSGS,WVSTAT,%DT,X,Y,DTOUT,WVPARAMS,WVPARAM,WVINST
D BMES^XPDUTL(" Clearing field values from existing WV PATIENT file entries:")
D MES^XPDUTL(" CURRENTLY PREGNANT (#.13)")
D MES^XPDUTL(" EDC (#.14)")
S WVIEN=0 F S WVIEN=$O(^WV(790,WVIEN)) Q:'WVIEN D
.I $P(^WV(790,WVIEN,0),U,13)'="" S $P(^(0),U,13)=""
.I $P(^WV(790,WVIEN,0),U,14)'="" S $P(^(0),U,14)=""
D MES^XPDUTL(" Finished clearing existing values")
D CONVERT
S %DT="P",X="T-1M" D ^%DT
I $G(Y)>0 S WVPARAMS("WV IMAGING ORDER START DT",1)=1_U_Y
E S WVMSGS(1)=" Unable to calculate imaging order start date.",WVMSGS(2)=" Unknown date calculation error." D MES^XPDUTL(.WVMSGS)
S WVPARAMS("WV COVER SHEET WEBSITES",1)="U. S. MEC for Contraceptive Use"_U_"http://www.cdc.gov/reproductivehealth/unintendedpregnancy/usmec.htm"
S WVPARAMS("WV COVER SHEET WEBSITES",2)="U. S. SPR for Contraceptive Use"_U_"http://www.cdc.gov/reproductivehealth/unintendedpregnancy/usspr.htm"
S WVPARAMS("WV ENTERED IN ERROR REASONS",1)=1_U_"Wrong patient"
S WVPARAM="" F S WVPARAM=$O(WVPARAMS(WVPARAM)) Q:WVPARAM="" D
.S WVMSGS(1)=" ",WVMSGS(2)=" Setting parameter "_WVPARAM_"..."
.D BMES^XPDUTL(.WVMSGS)
.S WVINST=0 F S WVINST=$O(WVPARAMS(WVPARAM,WVINST)) Q:'+WVINST!(+$G(WVSTAT)>0) D
..D EN^XPAR("PKG",WVPARAM,$P(WVPARAMS(WVPARAM,WVINST),U),$P(WVPARAMS(WVPARAM,WVINST),U,2),.WVSTAT)
..I +WVSTAT>0 K WVMSGS S WVMSGS(1)=" FAILED",WVMSGS(2)=" "_$P(WVSTAT,U,2) D MES^XPDUTL(.WVMSGS)
.I +WVSTAT=0 D MES^XPDUTL(" DONE")
D POSTACC,POSTCOM
Q
;
CONVERT ;CONVERT EXISTING PREGNANCY DATA INTO NEW FORMAT
I '$D(^WV(790.05)) Q
I $O(^WV(790.05,0))="" K ^WV(790.05) Q
D BMES^XPDUTL(" Converting existing pregnancy data...")
N WVNOALRT,WVIEN,WVFDA,WVPNUM,%DT,X,Y,DTOUT,WVEXIT,WVDFN,WVNODE,WVNIEN,WVERROR,WVMSGS,WVPKG
S %DT="TS",WVNOALRT=1,WVPKG=+$$FIND1^DIC(9.4,,,"WOMEN'S HEALTH",,"I $P($G(^(0)),U,2)=""WV""","WVERROR")
I 'WVPKG D Q
.S WVMSGS(1)=" ERROR encountered:",WVMSGS(2)=" "_$$FMERROR^WVUTL11(.WVERROR)
.S WVMSGS(3)=" Could not find the WOMEN'S HEALTH entry in the PACKAGE file (#9.4)."
.S WVMSGS(4)=" Please contact the national help desk for assistance."
.D MES^XPDUTL(.WVMSGS)
S WVIEN=0 F S WVIEN=$O(^WV(790.05,WVIEN)) Q:'+WVIEN!($D(WVERROR)) D
.S WVNODE=$G(^WV(790.05,WVIEN,0)),WVDFN=$P(WVNODE,U,2)
.I '$D(^WV(790,WVDFN,0)) K ^WV(790.05,WVIEN) Q
.F WVPNUM=1,4 S X=$P(WVNODE,U,WVPNUM) D
..I +X'>0 S $P(WVNODE,U,WVPNUM)="" Q
..D ^%DT I Y'>0 S $P(WVNODE,U,WVPNUM)=""
.I $P(WVNODE,U)="" K ^WV(790.05,WVIEN) Q
.S WVFDA(790.05,"+1,"_WVDFN_",",.01)=$P(WVNODE,U),WVFDA(790.05,"+1,"_WVDFN_",",3)=WVPKG
.S WVFDA(790.05,"+1,"_WVDFN_",",21)=$P(WVNODE,U,3)
.S:$P(WVNODE,U,4)'="" WVFDA(790.05,"+1,"_WVDFN_",",42)=$P(WVNODE,U,4)
.D UPDATE^DIE(,"WVFDA","WVNIEN","WVERROR")
.I $D(WVERROR) D Q
..S WVMSGS(1)=" ERROR encountered while converting record #"_WVIEN_":"
..S WVMSGS(2)=" "_$$FMERROR^WVUTL11(.WVERROR)
..S WVMSGS(3)=" The data conversion is incomplete; please"
..S WVMSGS(4)=" contact the national help desk for assistance."
..D MES^XPDUTL(.WVMSGS)
.S $P(^WV(790,WVDFN,4,WVNIEN(1),0),U,2)=""
.K WVNIEN
I '$D(WVERROR) K ^WV(790.05) D MES^XPDUTL(" DONE")
Q
;
POSTACC ;
N ACCESS,FDA,IEN,MSG,SUB
S SUB="WV ACCESS#"
S IEN=$O(^WV(790.2,"B","BREAST MRI","")) Q:IEN'>0
I '$D(^XTMP(SUB)) D Q
.S FDA(790.2,"42,",.06)=""
.D FILE^DIE("","FDA","MSG")
S ACCESS=$G(^XTMP(SUB,"BREAST MRI")) I ACCESS="" Q
S IEN=$O(^WV(790.2,"B","BREAST MRI","")) Q:IEN'>0
S FDA(790.2,"42,",.06)=ACCESS
D FILE^DIE("","FDA","MSG")
I $D(MSG) D MES^XPDUTL("Error Updating BREAST MRI Last Accession #") Q
K ^XTMP(SUB)
Q
;
POSTCOM ;
N COM,DA,DIE,DR,WVIEN,WVXTMP
S WVXTMP="WV COMMENTS CONVERSION"
I '$D(^XTMP(WVXTMP)) Q
S DA(1)=0 F S DA(1)=$O(^XTMP(WVXTMP,DA(1))) Q:DA(1)'>0 D
.S DA=0 F S DA=$O(^XTMP(WVXTMP,DA(1),DA)) Q:DA'>0 D
..S COM=$G(^XTMP(WVXTMP,DA(1),DA)) Q:COM=""
..S DIE="^WV(790.1,"_DA(1)_",10,",DR="15///^S X=COM" D ^DIE
K ^XTMP(WVXTMP)
Q
;
GETLIST(ARRAY,WHAT) ;
N LINE
I WHAT="PURPOSE" D Q
.F LINE=1:1 Q:$L($T(PURLIST+LINE))<3 D
..N TEXT
..S TEXT=$P($T(PURLIST+LINE),";;",2)
..S ARRAY(TEXT)=""
I WHAT="TYPE" D Q
.F LINE=1:1 Q:$L($T(TYPELIST+LINE))<3 D
..N TEXT
..S TEXT=$P($T(TYPELIST+LINE),";;",2)
..S ARRAY(TEXT)=""
I WHAT="DIAGNOSIS" D Q
.F LINE=1:1 Q:$L($T(DIAGLIST+LINE))<3 D
..N TEXT
..S TEXT=$P($T(DIAGLIST+LINE),";;",2)
..S ARRAY(TEXT)=""
I WHAT="TRANSLATION" D Q
.F LINE=1:1 Q:$L($T(TRANS+LINE))<3 D
..N TEXT
..S TEXT=$P($T(TRANS+LINE),";;",2)
..S ARRAY(TEXT)=""
Q
;
REPRES ;
N FDA,IEN,NAME,NODE,TEMP,X,VALUE,ID
S IEN=0 F S IEN=$O(^XTMP("WV MRI RECORDS","IENS",IEN)) Q:IEN'>0 D
.I '$D(^WV(790.31,"P",IEN)) Q
.S ID=0 F S ID=$O(^WV(790.31,"P",IEN,ID)) Q:ID'>0 D
..K TEMP
..D GETS^DIQ(790.31,ID,"**","I","TEMP","MSG")
..K FDA
..S X=.02 F S X=$O(TEMP(790.31,ID_",",X)) Q:X'>0!(X>.19) D
...I $G(TEMP(790.31,ID_",",X,"I"))'=IEN Q
...K FDA
...S FDA(790.31,ID_",",X)=42
..I '$D(FDA) Q
..S FDA(790.31,ID_",",.01)=$G(TEMP(790.31,ID_",",.01,"I"))
..D UPDATE^DIE("","FDA","","MSG")
..I $D(MSG) D MES^XPDUTL("Error updating file 790.31: "_ID) Q
Q
;
SETMRI ;
I $P($G(^WV(790.2,42,0)),U)="BREAST MRI" Q
N FDA,MSG,WVAIEN
S FDA(790.2,"+1,",.01)="BREAST MRI"
S WVAIEN(1)=42
D UPDATE^DIE("","FDA","WVAIEN","MSG")
I $D(MSG) D MES^XPDUTL("Error setting BREAST MRI entry") Q
I +$G(WVAIEN(1))'=42 D MES^XPDUTL("BREAST MRI not set to the correct entry") Q
Q
;
SETBTOMO ;
I $P($G(^WV(790.2,45,0)),U)="BREAST TOMOSYNTHESIS BILAT" Q
N FDA,MSG,WVAIEN
S FDA(790.2,"+1,",.01)="BREAST TOMOSYNTHESIS BILAT"
S WVAIEN(1)=45
D UPDATE^DIE("","FDA","WVAIEN","MSG")
I $D(MSG) D MES^XPDUTL("Error setting BREAST TOMOSYNTHESIS BILAT entry") Q
I +$G(WVAIEN(1))'=45 D MES^XPDUTL("BREAST TOMOSYNTHESIS BILAT not set to the correct entry") Q
;
I $P($G(^WV(790.2,46,0)),U)="BREAST TOMOSYNTHESIS SCREENING" Q
N FDA,MSG,WVAIEN
S FDA(790.2,"+1,",.01)="BREAST TOMOSYNTHESIS SCREENING"
S WVAIEN(1)=46
D UPDATE^DIE("","FDA","WVAIEN","MSG")
I $D(MSG) D MES^XPDUTL("Error setting BREAST TOMOSYNTHESIS SCREENING entry") Q
I +$G(WVAIEN(1))'=46 D MES^XPDUTL("BREAST TOMOSYNTHESIS SCREENING not set to the correct entry") Q
;
I $P($G(^WV(790.2,47,0)),U)="BREAST TOMOSYNTHESIS UNILAT" Q
N FDA,MSG,WVAIEN
S FDA(790.2,"+1,",.01)="BREAST TOMOSYNTHESIS UNILAT"
S WVAIEN(1)=47
D UPDATE^DIE("","FDA","WVAIEN","MSG")
I $D(MSG) D MES^XPDUTL("Error setting BREAST TOMOSYNTHESIS UNILAT entry") Q
I +$G(WVAIEN(1))'=47 D MES^XPDUTL("BREAST TOMOSYNTHESIS UNILAT not set to the correct entry") Q
Q
;
SENDDIAG(ANAME) ;
N ARRAY
D GETLIST(.ARRAY,"DIAGNOSIS")
I $D(ARRAY(ANAME)) Q 1
Q 0
;
SENDDX(ANAME) ;
N ARRAY
D GETLIST(.ARRAY,"TRANSLATION")
I $D(ARRAY(ANAME)) Q 1
Q 0
;
SENDPUR(ANAME) ;
N ARRAY
D GETLIST(.ARRAY,"PURPOSE")
I $D(ARRAY(ANAME)) Q 1
Q 0
;
SENDTYPE(ANAME) ;
N ARRAY
D GETLIST(.ARRAY,"TYPE")
I $D(ARRAY(ANAME)) Q 1
Q 0
;
DIAGLIST ;
;;BI-RADS CATEGORY 0
;;BI-RADS CATEGORY 1
;;BI-RADS CATEGORY 2
;;BI-RADS CATEGORY 3
;;BI-RADS CATEGORY 4
;;BI-RADS CATEGORY 5
;;BI-RADS CATEGORY 6
;;Abnormal
;;No Evidence of Malignancy
;;Unsatisfactory for Dx
Q
;
PURLIST ;
;;BR 0 BIOPSY ALREADY OBTAIN
;;BR 0 CURRENTLY UNDER TREATMENT
;;BR 0 REFER FOR BIOPSY
;;BR 0 REFER TO ONCOLOGIST
;;BR 0 REFER TO SURGEON
;;BR 3 BIOPSY ALREADY OBTAIN
;;BR 3 CURRENTLY UNDER TREATMENT
;;BR 3 REFER FOR BIOPSY
;;BR 3 REFER TO ONCOLOGIST
;;BR 3 REFER TO SURGEON
;;BR 4 BIOPSY ALREADY OBTAIN
;;BR 4 CURRENTLY UNDER TREATMENT
;;BR 4 REFER FOR BIOPSY
;;BR 4 REFER TO ONCOLOGIST
;;BR 4 REFER TO SURGEON
;;BR 5 BIOPSY ALREADY OBTAIN
;;BR 5 CURRENTLY UNDER TREATMENT
;;BR 5 REFER FOR BIOPSY
;;BR 5 REFER TO ONCOLOGIST
;;BR 5 REFER TO SURGEON
;;BR 6 BIOPSY ALREADY OBTAIN
;;BR 6 CURRENTLY UNDER TREATMENT
;;BR 6 REFER FOR BIOPSY
;;BR 6 REFER TO ONCOLOGIST
;;BR 6 REFER TO SURGEON
;;BR ABNORMAL BIOPSY ALREADY OBTAIN
;;BR ABNORMAL CONSULT
;;BR ABNORMAL CURRENTLY UNDER TREATMENT
;;BR ABNORMAL OBTAIN PRIOR FILMS
;;BR ABNORMAL REFER FOR BIOPSY
;;BR ABNORMAL REFER TO ONCOLOGIST
;;BR ABNORMAL REFER TO SURGEON
;;BR ABNORMAL, ORDER MRI
;;BR ABNORMAL, ORDER ULTRASOUND
;;BR BIRAD 0 CONSULT
;;BR BIRAD 0 OBTAIN PRIOR FILMS
;;BR BIRAD 0, ORDER MRI
;;BR BIRAD 0, ORDER ULTRASOUND
;;BR BIRAD 0, next MAM 1M
;;BR BIRAD 0, next MAM 2M
;;BR BIRAD 0, next MAM 3M
;;BR BIRAD 0, next MAM 4M
;;BR BIRAD 0, next MAM 5M
;;BR BIRAD 0, next MAM 6M
;;BR BIRAD 1, next MAM 1Y
;;BR BIRAD 1, next MAM 2Y
;;BR BIRAD 2, next MAM 1Y
;;BR BIRAD 2, next MAM 2Y
;;BR BIRAD 3 CONSULT
;;BR BIRAD 3 OBTAIN PRIOR FILMS
;;BR BIRAD 3, ORDER MRI
;;BR BIRAD 3, ORDER ULTRASOUND
;;BR BIRAD 3, next MAM 1M
;;BR BIRAD 3, next MAM 2M
;;BR BIRAD 3, next MAM 3M
;;BR BIRAD 3, next MAM 4M
;;BR BIRAD 3, next MAM 5M
;;BR BIRAD 3, next MAM 6M
;;BR BIRAD 3, next MAM 12M
;;BR BIRAD 4 CONSULT
;;BR BIRAD 4 OBTAIN PRIOR FILMS
;;BR BIRAD 4, ORDER MRI
;;BR BIRAD 4, ORDER ULTRASOUND
;;BR BIRAD 4, next MAM 1M
;;BR BIRAD 4, next MAM 2M
;;BR BIRAD 4, next MAM 3M
;;BR BIRAD 4, next MAM 4M
;;BR BIRAD 4, next MAM 5M
;;BR BIRAD 4, next MAM 6M
;;BR BIRAD 5 CONSULT
;;BR BIRAD 5 OBTAIN PRIOR FILMS
;;BR BIRAD 5, ORDER MRI
;;BR BIRAD 5, ORDER ULTRASOUND
;;BR BIRAD 5, next MAM 1M
;;BR BIRAD 5, next MAM 2M
;;BR BIRAD 5, next MAM 3M
;;BR BIRAD 5, next MAM 4M
;;BR BIRAD 5, next MAM 5M
;;BR BIRAD 5, next MAM 6M
;;BR BIRAD 6
;;BR BIRAD 6 CONSULT
;;BR BIRAD 6 OBTAIN PRIOR FILMS
;;BR BIRAD 6, next MAM 1M
;;BR BIRAD 6, next MAM 2M
;;BR BIRAD 6, next MAM 3M
;;BR BIRAD 6, next MAM 4M
;;BR BIRAD 6, next MAM 5M
;;BR BIRAD 6, next MAM 6M
;;BR BIRAD 6, ORDER MRI
;;BR BIRAD 6, ORDER ULTRASOUND
;;BR NOT INDICATED
;;BR RESULT ABNORMAL, NEXT MAM 1M
;;BR RESULT ABNORMAL, NEXT MAM 2M
;;BR RESULT ABNORMAL, NEXT MAM 3M
;;BR RESULT ABNORMAL, NEXT MAM 4M
;;BR RESULT ABNORMAL, NEXT MAM 5M
;;BR RESULT ABNORMAL, NEXT MAM 6M
;;BR RESULT NEM, NEXT MAM 1Y
;;BR RESULT NEM, NEXT MAM 2Y
;;BR RESULT UNSATISFACTORY, NEXT MAM 1M
;;BR RESULT UNSATISFACTORY, NEXT MAM 2M
;;BR RESULT UNSATISFACTORY, NEXT MAM 3M
;;BR RESULT UNSATISFACTORY, NEXT MAM 4M
;;BR RESULT UNSATISFACTORY, NEXT MAM 5M
;;BR RESULT UNSATISFACTORY, NEXT MAM 6M
;;BR UNSATISFACTORY BIOPSY ALREADY OBTAIN
;;BR UNSATISFACTORY CONSULT
;;BR UNSATISFACTORY CURRENTLY UNDER TREATMENT
;;BR UNSATISFACTORY OBTAIN PRIOR FILMS
;;BR UNSATISFACTORY REFER FOR BIOPSY
;;BR UNSATISFACTORY REFER TO ONCOLOGIST
;;BR UNSATISFACTORY REFER TO SURGEON
;;BR UNSATISFACTORY, ORDER MRI
;;BR UNSATISFACTORY, ORDER ULTRASOUND
;;MAM unsatisfactory, need repeat
;;BR BIRAD 1, next MAM AGE AT START AGE
;;BR BIRAD 1, next MAM AGE 1Y
;;BR BIRAD 1, next MAM AGE 2Y
;;BR BIRAD 2, next MAM AGE AT START AGE
;;BR BIRAD 2, next MAM AGE 1Y
;;BR BIRAD 2, next MAM AGE 2Y
;;BR NEM, next MAM AGE AT START AGE
;;BR NEM, next MAM AGE 1Y
;;BR NEM, next MAM AGE 2Y
;;BR RETURN FOR MAM AT START AGE
;;BR RETURN FOR MAM 1Y
Q
;
TRANS ;
;;162
;;163
;;164
;;165
;;166
;;167
;;168
Q
;
TYPELIST ;
;;CONVERSATION WITH PATIENT
;;LETTER (CERTIFIED)
;;LETTER, FIRST
;;PHONE CALL, 1ST
;;SECURE MESSAGING
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWV1024P 13774 printed Dec 13, 2024@02:46:20 Page 2
WV1024P ;ISP/RFR - PATCH 24 INSTALLATION TASKS;03/25/2020
+1 ;;1.0;WOMEN'S HEALTH;**24**;Sep 30, 1998;Build 582
+2 IF '$$PATCH^XPDUTL("WV*1.0*24")
Begin DoDot:1
+3 NEW X
+4 FOR X=42,45,46,47
Begin DoDot:2
+5 IF $PIECE($GET(^WV(790.2,X,0)),U)'=""
Begin DoDot:3
+6 WRITE !,"WV Procedure Type entry found at IEN: "_X
SET XPDABORT=2
End DoDot:3
End DoDot:2
End DoDot:1
+7 QUIT
+8 ;
PRE ;PRE-INSTALL ACTIONS
+1 DO BMES^XPDUTL(" Deleting data dictionaries:")
+2 DO MES^XPDUTL(" WV PREGNANCY LOG (#790.05)")
+3 NEW DIU
+4 SET DIU=790.05
SET DIU(0)="T"
+5 DO EN^DIU2
+6 DO MES^XPDUTL(" WV CASE MANAGER (#790.01)")
+7 SET DIU=790.01
SET DIU(0)=""
+8 DO EN^DIU2
+9 DO MES^XPDUTL(" CURRENTLY PREGNANT FIELD (#.13) IN WV PATIENT FILE")
+10 NEW DIK,DA
+11 SET DIK="^DD(790,"
SET DA=.13
SET DA(1)=790
+12 DO ^DIK
+13 DO MES^XPDUTL(" EDC FIELD (#.14) IN WV PATIENT FILE")
+14 SET DIK="^DD(790,"
SET DA=.14
SET DA(1)=790
+15 DO ^DIK
+16 DO MES^XPDUTL(" Finished deleting data dictionaries")
+17 IF $$LKOPT^XPDMENU("WV EDIT PREGNANCY LOG")>0
Begin DoDot:1
+18 DO BMES^XPDUTL(" Renaming option WV EDIT PREGNANCY LOG")
+19 DO RENAME^XPDMENU("WV EDIT PREGNANCY LOG","WV EDIT PREG/LAC STATUS DATA")
+20 DO MES^XPDUTL(" Finished renaming option WV EDIT PREGNANCY LOG")
End DoDot:1
+21 NEW WVMSGS,WVSTAT
+22 SET WVMSGS(1)=" "
+23 SET WVMSGS(2)=" Removing the Transfer a Case Manager's Patients option"
+24 SET WVMSGS(3)=" from the FILE MAINTENANCE MENU"
+25 DO BMES^XPDUTL(.WVMSGS)
+26 SET WVSTAT=$$DELETE^XPDMENU("WV MENU-FILE MAINTENANCE","WV TRANSFER CASE MANAGER")
+27 IF WVSTAT
DO MES^XPDUTL(" Option successfully removed")
+28 IF 'WVSTAT
DO MES^XPDUTL(" Option not removed")
+29 DO SETMRI
DO GETACC
DO GETCOM
+30 DO SETBTOMO
+31 QUIT
+32 ;
GETACC ;
+1 NEW IEN,NODE,SUB
+2 SET SUB="WV ACCESS#"
+3 KILL ^XTMP(SUB)
+4 SET ^XTMP(SUB,0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"WV Patch 24 Accession #"
+5 SET IEN=$ORDER(^WV(790.2,"B","BREAST MRI",""))
if IEN'>0
QUIT
+6 SET ^XTMP(SUB,"BREAST MRI")=$PIECE($GET(^WV(790.2,IEN,0)),U,6)
+7 QUIT
+8 ;
GETCOM ;
+1 NEW DA,DIE,DR,CNT,WVIEN,WVXTMP
+2 SET WVXTMP="WV COMMENTS CONVERSION"
+3 KILL ^XTMP(WVXTMP)
+4 SET ^XTMP(WVXTMP,0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"WV Patch 24 Comment Conversion"
+5 SET WVIEN=0
FOR
SET WVIEN=$ORDER(^WV(790.1,WVIEN))
if WVIEN'>0
QUIT
Begin DoDot:1
+6 SET CNT=0
FOR
SET CNT=$ORDER(^WV(790.1,WVIEN,10,CNT))
if CNT'>0
QUIT
Begin DoDot:2
+7 IF $PIECE($GET(^WV(790.1,WVIEN,10,CNT,1)),U)=""
QUIT
+8 SET ^XTMP(WVXTMP,WVIEN,CNT)=$PIECE($GET(^WV(790.1,WVIEN,10,CNT,1)),U)
+9 SET DA(1)=WVIEN
SET DA=CNT
+10 SET DIE="^WV(790.1,"_DA(1)_",10,"
SET DR="3///@"
DO ^DIE
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
POST ;POST-INSTALL ACTIONS
+1 NEW WVIEN,WVMSGS,WVSTAT,%DT,X,Y,DTOUT,WVPARAMS,WVPARAM,WVINST
+2 DO BMES^XPDUTL(" Clearing field values from existing WV PATIENT file entries:")
+3 DO MES^XPDUTL(" CURRENTLY PREGNANT (#.13)")
+4 DO MES^XPDUTL(" EDC (#.14)")
+5 SET WVIEN=0
FOR
SET WVIEN=$ORDER(^WV(790,WVIEN))
if 'WVIEN
QUIT
Begin DoDot:1
+6 IF $PIECE(^WV(790,WVIEN,0),U,13)'=""
SET $PIECE(^(0),U,13)=""
+7 IF $PIECE(^WV(790,WVIEN,0),U,14)'=""
SET $PIECE(^(0),U,14)=""
End DoDot:1
+8 DO MES^XPDUTL(" Finished clearing existing values")
+9 DO CONVERT
+10 SET %DT="P"
SET X="T-1M"
DO ^%DT
+11 IF $GET(Y)>0
SET WVPARAMS("WV IMAGING ORDER START DT",1)=1_U_Y
+12 IF '$TEST
SET WVMSGS(1)=" Unable to calculate imaging order start date."
SET WVMSGS(2)=" Unknown date calculation error."
DO MES^XPDUTL(.WVMSGS)
+13 SET WVPARAMS("WV COVER SHEET WEBSITES",1)="U. S. MEC for Contraceptive Use"_U_"http://www.cdc.gov/reproductivehealth/unintendedpregnancy/usmec.htm"
+14 SET WVPARAMS("WV COVER SHEET WEBSITES",2)="U. S. SPR for Contraceptive Use"_U_"http://www.cdc.gov/reproductivehealth/unintendedpregnancy/usspr.htm"
+15 SET WVPARAMS("WV ENTERED IN ERROR REASONS",1)=1_U_"Wrong patient"
+16 SET WVPARAM=""
FOR
SET WVPARAM=$ORDER(WVPARAMS(WVPARAM))
if WVPARAM=""
QUIT
Begin DoDot:1
+17 SET WVMSGS(1)=" "
SET WVMSGS(2)=" Setting parameter "_WVPARAM_"..."
+18 DO BMES^XPDUTL(.WVMSGS)
+19 SET WVINST=0
FOR
SET WVINST=$ORDER(WVPARAMS(WVPARAM,WVINST))
if '+WVINST!(+$GET(WVSTAT)>0)
QUIT
Begin DoDot:2
+20 DO EN^XPAR("PKG",WVPARAM,$PIECE(WVPARAMS(WVPARAM,WVINST),U),$PIECE(WVPARAMS(WVPARAM,WVINST),U,2),.WVSTAT)
+21 IF +WVSTAT>0
KILL WVMSGS
SET WVMSGS(1)=" FAILED"
SET WVMSGS(2)=" "_$PIECE(WVSTAT,U,2)
DO MES^XPDUTL(.WVMSGS)
End DoDot:2
+22 IF +WVSTAT=0
DO MES^XPDUTL(" DONE")
End DoDot:1
+23 DO POSTACC
DO POSTCOM
+24 QUIT
+25 ;
CONVERT ;CONVERT EXISTING PREGNANCY DATA INTO NEW FORMAT
+1 IF '$DATA(^WV(790.05))
QUIT
+2 IF $ORDER(^WV(790.05,0))=""
KILL ^WV(790.05)
QUIT
+3 DO BMES^XPDUTL(" Converting existing pregnancy data...")
+4 NEW WVNOALRT,WVIEN,WVFDA,WVPNUM,%DT,X,Y,DTOUT,WVEXIT,WVDFN,WVNODE,WVNIEN,WVERROR,WVMSGS,WVPKG
+5 SET %DT="TS"
SET WVNOALRT=1
SET WVPKG=+$$FIND1^DIC(9.4,,,"WOMEN'S HEALTH",,"I $P($G(^(0)),U,2)=""WV""","WVERROR")
+6 IF 'WVPKG
Begin DoDot:1
+7 SET WVMSGS(1)=" ERROR encountered:"
SET WVMSGS(2)=" "_$$FMERROR^WVUTL11(.WVERROR)
+8 SET WVMSGS(3)=" Could not find the WOMEN'S HEALTH entry in the PACKAGE file (#9.4)."
+9 SET WVMSGS(4)=" Please contact the national help desk for assistance."
+10 DO MES^XPDUTL(.WVMSGS)
End DoDot:1
QUIT
+11 SET WVIEN=0
FOR
SET WVIEN=$ORDER(^WV(790.05,WVIEN))
if '+WVIEN!($DATA(WVERROR))
QUIT
Begin DoDot:1
+12 SET WVNODE=$GET(^WV(790.05,WVIEN,0))
SET WVDFN=$PIECE(WVNODE,U,2)
+13 IF '$DATA(^WV(790,WVDFN,0))
KILL ^WV(790.05,WVIEN)
QUIT
+14 FOR WVPNUM=1,4
SET X=$PIECE(WVNODE,U,WVPNUM)
Begin DoDot:2
+15 IF +X'>0
SET $PIECE(WVNODE,U,WVPNUM)=""
QUIT
+16 DO ^%DT
IF Y'>0
SET $PIECE(WVNODE,U,WVPNUM)=""
End DoDot:2
+17 IF $PIECE(WVNODE,U)=""
KILL ^WV(790.05,WVIEN)
QUIT
+18 SET WVFDA(790.05,"+1,"_WVDFN_",",.01)=$PIECE(WVNODE,U)
SET WVFDA(790.05,"+1,"_WVDFN_",",3)=WVPKG
+19 SET WVFDA(790.05,"+1,"_WVDFN_",",21)=$PIECE(WVNODE,U,3)
+20 if $PIECE(WVNODE,U,4)'=""
SET WVFDA(790.05,"+1,"_WVDFN_",",42)=$PIECE(WVNODE,U,4)
+21 DO UPDATE^DIE(,"WVFDA","WVNIEN","WVERROR")
+22 IF $DATA(WVERROR)
Begin DoDot:2
+23 SET WVMSGS(1)=" ERROR encountered while converting record #"_WVIEN_":"
+24 SET WVMSGS(2)=" "_$$FMERROR^WVUTL11(.WVERROR)
+25 SET WVMSGS(3)=" The data conversion is incomplete; please"
+26 SET WVMSGS(4)=" contact the national help desk for assistance."
+27 DO MES^XPDUTL(.WVMSGS)
End DoDot:2
QUIT
+28 SET $PIECE(^WV(790,WVDFN,4,WVNIEN(1),0),U,2)=""
+29 KILL WVNIEN
End DoDot:1
+30 IF '$DATA(WVERROR)
KILL ^WV(790.05)
DO MES^XPDUTL(" DONE")
+31 QUIT
+32 ;
POSTACC ;
+1 NEW ACCESS,FDA,IEN,MSG,SUB
+2 SET SUB="WV ACCESS#"
+3 SET IEN=$ORDER(^WV(790.2,"B","BREAST MRI",""))
if IEN'>0
QUIT
+4 IF '$DATA(^XTMP(SUB))
Begin DoDot:1
+5 SET FDA(790.2,"42,",.06)=""
+6 DO FILE^DIE("","FDA","MSG")
End DoDot:1
QUIT
+7 SET ACCESS=$GET(^XTMP(SUB,"BREAST MRI"))
IF ACCESS=""
QUIT
+8 SET IEN=$ORDER(^WV(790.2,"B","BREAST MRI",""))
if IEN'>0
QUIT
+9 SET FDA(790.2,"42,",.06)=ACCESS
+10 DO FILE^DIE("","FDA","MSG")
+11 IF $DATA(MSG)
DO MES^XPDUTL("Error Updating BREAST MRI Last Accession #")
QUIT
+12 KILL ^XTMP(SUB)
+13 QUIT
+14 ;
POSTCOM ;
+1 NEW COM,DA,DIE,DR,WVIEN,WVXTMP
+2 SET WVXTMP="WV COMMENTS CONVERSION"
+3 IF '$DATA(^XTMP(WVXTMP))
QUIT
+4 SET DA(1)=0
FOR
SET DA(1)=$ORDER(^XTMP(WVXTMP,DA(1)))
if DA(1)'>0
QUIT
Begin DoDot:1
+5 SET DA=0
FOR
SET DA=$ORDER(^XTMP(WVXTMP,DA(1),DA))
if DA'>0
QUIT
Begin DoDot:2
+6 SET COM=$GET(^XTMP(WVXTMP,DA(1),DA))
if COM=""
QUIT
+7 SET DIE="^WV(790.1,"_DA(1)_",10,"
SET DR="15///^S X=COM"
DO ^DIE
End DoDot:2
End DoDot:1
+8 KILL ^XTMP(WVXTMP)
+9 QUIT
+10 ;
GETLIST(ARRAY,WHAT) ;
+1 NEW LINE
+2 IF WHAT="PURPOSE"
Begin DoDot:1
+3 FOR LINE=1:1
if $LENGTH($TEXT(PURLIST+LINE))<3
QUIT
Begin DoDot:2
+4 NEW TEXT
+5 SET TEXT=$PIECE($TEXT(PURLIST+LINE),";;",2)
+6 SET ARRAY(TEXT)=""
End DoDot:2
End DoDot:1
QUIT
+7 IF WHAT="TYPE"
Begin DoDot:1
+8 FOR LINE=1:1
if $LENGTH($TEXT(TYPELIST+LINE))<3
QUIT
Begin DoDot:2
+9 NEW TEXT
+10 SET TEXT=$PIECE($TEXT(TYPELIST+LINE),";;",2)
+11 SET ARRAY(TEXT)=""
End DoDot:2
End DoDot:1
QUIT
+12 IF WHAT="DIAGNOSIS"
Begin DoDot:1
+13 FOR LINE=1:1
if $LENGTH($TEXT(DIAGLIST+LINE))<3
QUIT
Begin DoDot:2
+14 NEW TEXT
+15 SET TEXT=$PIECE($TEXT(DIAGLIST+LINE),";;",2)
+16 SET ARRAY(TEXT)=""
End DoDot:2
End DoDot:1
QUIT
+17 IF WHAT="TRANSLATION"
Begin DoDot:1
+18 FOR LINE=1:1
if $LENGTH($TEXT(TRANS+LINE))<3
QUIT
Begin DoDot:2
+19 NEW TEXT
+20 SET TEXT=$PIECE($TEXT(TRANS+LINE),";;",2)
+21 SET ARRAY(TEXT)=""
End DoDot:2
End DoDot:1
QUIT
+22 QUIT
+23 ;
REPRES ;
+1 NEW FDA,IEN,NAME,NODE,TEMP,X,VALUE,ID
+2 SET IEN=0
FOR
SET IEN=$ORDER(^XTMP("WV MRI RECORDS","IENS",IEN))
if IEN'>0
QUIT
Begin DoDot:1
+3 IF '$DATA(^WV(790.31,"P",IEN))
QUIT
+4 SET ID=0
FOR
SET ID=$ORDER(^WV(790.31,"P",IEN,ID))
if ID'>0
QUIT
Begin DoDot:2
+5 KILL TEMP
+6 DO GETS^DIQ(790.31,ID,"**","I","TEMP","MSG")
+7 KILL FDA
+8 SET X=.02
FOR
SET X=$ORDER(TEMP(790.31,ID_",",X))
if X'>0!(X>.19)
QUIT
Begin DoDot:3
+9 IF $GET(TEMP(790.31,ID_",",X,"I"))'=IEN
QUIT
+10 KILL FDA
+11 SET FDA(790.31,ID_",",X)=42
End DoDot:3
+12 IF '$DATA(FDA)
QUIT
+13 SET FDA(790.31,ID_",",.01)=$GET(TEMP(790.31,ID_",",.01,"I"))
+14 DO UPDATE^DIE("","FDA","","MSG")
+15 IF $DATA(MSG)
DO MES^XPDUTL("Error updating file 790.31: "_ID)
QUIT
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
SETMRI ;
+1 IF $PIECE($GET(^WV(790.2,42,0)),U)="BREAST MRI"
QUIT
+2 NEW FDA,MSG,WVAIEN
+3 SET FDA(790.2,"+1,",.01)="BREAST MRI"
+4 SET WVAIEN(1)=42
+5 DO UPDATE^DIE("","FDA","WVAIEN","MSG")
+6 IF $DATA(MSG)
DO MES^XPDUTL("Error setting BREAST MRI entry")
QUIT
+7 IF +$GET(WVAIEN(1))'=42
DO MES^XPDUTL("BREAST MRI not set to the correct entry")
QUIT
+8 QUIT
+9 ;
SETBTOMO ;
+1 IF $PIECE($GET(^WV(790.2,45,0)),U)="BREAST TOMOSYNTHESIS BILAT"
QUIT
+2 NEW FDA,MSG,WVAIEN
+3 SET FDA(790.2,"+1,",.01)="BREAST TOMOSYNTHESIS BILAT"
+4 SET WVAIEN(1)=45
+5 DO UPDATE^DIE("","FDA","WVAIEN","MSG")
+6 IF $DATA(MSG)
DO MES^XPDUTL("Error setting BREAST TOMOSYNTHESIS BILAT entry")
QUIT
+7 IF +$GET(WVAIEN(1))'=45
DO MES^XPDUTL("BREAST TOMOSYNTHESIS BILAT not set to the correct entry")
QUIT
+8 ;
+9 IF $PIECE($GET(^WV(790.2,46,0)),U)="BREAST TOMOSYNTHESIS SCREENING"
QUIT
+10 NEW FDA,MSG,WVAIEN
+11 SET FDA(790.2,"+1,",.01)="BREAST TOMOSYNTHESIS SCREENING"
+12 SET WVAIEN(1)=46
+13 DO UPDATE^DIE("","FDA","WVAIEN","MSG")
+14 IF $DATA(MSG)
DO MES^XPDUTL("Error setting BREAST TOMOSYNTHESIS SCREENING entry")
QUIT
+15 IF +$GET(WVAIEN(1))'=46
DO MES^XPDUTL("BREAST TOMOSYNTHESIS SCREENING not set to the correct entry")
QUIT
+16 ;
+17 IF $PIECE($GET(^WV(790.2,47,0)),U)="BREAST TOMOSYNTHESIS UNILAT"
QUIT
+18 NEW FDA,MSG,WVAIEN
+19 SET FDA(790.2,"+1,",.01)="BREAST TOMOSYNTHESIS UNILAT"
+20 SET WVAIEN(1)=47
+21 DO UPDATE^DIE("","FDA","WVAIEN","MSG")
+22 IF $DATA(MSG)
DO MES^XPDUTL("Error setting BREAST TOMOSYNTHESIS UNILAT entry")
QUIT
+23 IF +$GET(WVAIEN(1))'=47
DO MES^XPDUTL("BREAST TOMOSYNTHESIS UNILAT not set to the correct entry")
QUIT
+24 QUIT
+25 ;
SENDDIAG(ANAME) ;
+1 NEW ARRAY
+2 DO GETLIST(.ARRAY,"DIAGNOSIS")
+3 IF $DATA(ARRAY(ANAME))
QUIT 1
+4 QUIT 0
+5 ;
SENDDX(ANAME) ;
+1 NEW ARRAY
+2 DO GETLIST(.ARRAY,"TRANSLATION")
+3 IF $DATA(ARRAY(ANAME))
QUIT 1
+4 QUIT 0
+5 ;
SENDPUR(ANAME) ;
+1 NEW ARRAY
+2 DO GETLIST(.ARRAY,"PURPOSE")
+3 IF $DATA(ARRAY(ANAME))
QUIT 1
+4 QUIT 0
+5 ;
SENDTYPE(ANAME) ;
+1 NEW ARRAY
+2 DO GETLIST(.ARRAY,"TYPE")
+3 IF $DATA(ARRAY(ANAME))
QUIT 1
+4 QUIT 0
+5 ;
DIAGLIST ;
+1 ;;BI-RADS CATEGORY 0
+2 ;;BI-RADS CATEGORY 1
+3 ;;BI-RADS CATEGORY 2
+4 ;;BI-RADS CATEGORY 3
+5 ;;BI-RADS CATEGORY 4
+6 ;;BI-RADS CATEGORY 5
+7 ;;BI-RADS CATEGORY 6
+8 ;;Abnormal
+9 ;;No Evidence of Malignancy
+10 ;;Unsatisfactory for Dx
+11 QUIT
+12 ;
PURLIST ;
+1 ;;BR 0 BIOPSY ALREADY OBTAIN
+2 ;;BR 0 CURRENTLY UNDER TREATMENT
+3 ;;BR 0 REFER FOR BIOPSY
+4 ;;BR 0 REFER TO ONCOLOGIST
+5 ;;BR 0 REFER TO SURGEON
+6 ;;BR 3 BIOPSY ALREADY OBTAIN
+7 ;;BR 3 CURRENTLY UNDER TREATMENT
+8 ;;BR 3 REFER FOR BIOPSY
+9 ;;BR 3 REFER TO ONCOLOGIST
+10 ;;BR 3 REFER TO SURGEON
+11 ;;BR 4 BIOPSY ALREADY OBTAIN
+12 ;;BR 4 CURRENTLY UNDER TREATMENT
+13 ;;BR 4 REFER FOR BIOPSY
+14 ;;BR 4 REFER TO ONCOLOGIST
+15 ;;BR 4 REFER TO SURGEON
+16 ;;BR 5 BIOPSY ALREADY OBTAIN
+17 ;;BR 5 CURRENTLY UNDER TREATMENT
+18 ;;BR 5 REFER FOR BIOPSY
+19 ;;BR 5 REFER TO ONCOLOGIST
+20 ;;BR 5 REFER TO SURGEON
+21 ;;BR 6 BIOPSY ALREADY OBTAIN
+22 ;;BR 6 CURRENTLY UNDER TREATMENT
+23 ;;BR 6 REFER FOR BIOPSY
+24 ;;BR 6 REFER TO ONCOLOGIST
+25 ;;BR 6 REFER TO SURGEON
+26 ;;BR ABNORMAL BIOPSY ALREADY OBTAIN
+27 ;;BR ABNORMAL CONSULT
+28 ;;BR ABNORMAL CURRENTLY UNDER TREATMENT
+29 ;;BR ABNORMAL OBTAIN PRIOR FILMS
+30 ;;BR ABNORMAL REFER FOR BIOPSY
+31 ;;BR ABNORMAL REFER TO ONCOLOGIST
+32 ;;BR ABNORMAL REFER TO SURGEON
+33 ;;BR ABNORMAL, ORDER MRI
+34 ;;BR ABNORMAL, ORDER ULTRASOUND
+35 ;;BR BIRAD 0 CONSULT
+36 ;;BR BIRAD 0 OBTAIN PRIOR FILMS
+37 ;;BR BIRAD 0, ORDER MRI
+38 ;;BR BIRAD 0, ORDER ULTRASOUND
+39 ;;BR BIRAD 0, next MAM 1M
+40 ;;BR BIRAD 0, next MAM 2M
+41 ;;BR BIRAD 0, next MAM 3M
+42 ;;BR BIRAD 0, next MAM 4M
+43 ;;BR BIRAD 0, next MAM 5M
+44 ;;BR BIRAD 0, next MAM 6M
+45 ;;BR BIRAD 1, next MAM 1Y
+46 ;;BR BIRAD 1, next MAM 2Y
+47 ;;BR BIRAD 2, next MAM 1Y
+48 ;;BR BIRAD 2, next MAM 2Y
+49 ;;BR BIRAD 3 CONSULT
+50 ;;BR BIRAD 3 OBTAIN PRIOR FILMS
+51 ;;BR BIRAD 3, ORDER MRI
+52 ;;BR BIRAD 3, ORDER ULTRASOUND
+53 ;;BR BIRAD 3, next MAM 1M
+54 ;;BR BIRAD 3, next MAM 2M
+55 ;;BR BIRAD 3, next MAM 3M
+56 ;;BR BIRAD 3, next MAM 4M
+57 ;;BR BIRAD 3, next MAM 5M
+58 ;;BR BIRAD 3, next MAM 6M
+59 ;;BR BIRAD 3, next MAM 12M
+60 ;;BR BIRAD 4 CONSULT
+61 ;;BR BIRAD 4 OBTAIN PRIOR FILMS
+62 ;;BR BIRAD 4, ORDER MRI
+63 ;;BR BIRAD 4, ORDER ULTRASOUND
+64 ;;BR BIRAD 4, next MAM 1M
+65 ;;BR BIRAD 4, next MAM 2M
+66 ;;BR BIRAD 4, next MAM 3M
+67 ;;BR BIRAD 4, next MAM 4M
+68 ;;BR BIRAD 4, next MAM 5M
+69 ;;BR BIRAD 4, next MAM 6M
+70 ;;BR BIRAD 5 CONSULT
+71 ;;BR BIRAD 5 OBTAIN PRIOR FILMS
+72 ;;BR BIRAD 5, ORDER MRI
+73 ;;BR BIRAD 5, ORDER ULTRASOUND
+74 ;;BR BIRAD 5, next MAM 1M
+75 ;;BR BIRAD 5, next MAM 2M
+76 ;;BR BIRAD 5, next MAM 3M
+77 ;;BR BIRAD 5, next MAM 4M
+78 ;;BR BIRAD 5, next MAM 5M
+79 ;;BR BIRAD 5, next MAM 6M
+80 ;;BR BIRAD 6
+81 ;;BR BIRAD 6 CONSULT
+82 ;;BR BIRAD 6 OBTAIN PRIOR FILMS
+83 ;;BR BIRAD 6, next MAM 1M
+84 ;;BR BIRAD 6, next MAM 2M
+85 ;;BR BIRAD 6, next MAM 3M
+86 ;;BR BIRAD 6, next MAM 4M
+87 ;;BR BIRAD 6, next MAM 5M
+88 ;;BR BIRAD 6, next MAM 6M
+89 ;;BR BIRAD 6, ORDER MRI
+90 ;;BR BIRAD 6, ORDER ULTRASOUND
+91 ;;BR NOT INDICATED
+92 ;;BR RESULT ABNORMAL, NEXT MAM 1M
+93 ;;BR RESULT ABNORMAL, NEXT MAM 2M
+94 ;;BR RESULT ABNORMAL, NEXT MAM 3M
+95 ;;BR RESULT ABNORMAL, NEXT MAM 4M
+96 ;;BR RESULT ABNORMAL, NEXT MAM 5M
+97 ;;BR RESULT ABNORMAL, NEXT MAM 6M
+98 ;;BR RESULT NEM, NEXT MAM 1Y
+99 ;;BR RESULT NEM, NEXT MAM 2Y
+100 ;;BR RESULT UNSATISFACTORY, NEXT MAM 1M
+101 ;;BR RESULT UNSATISFACTORY, NEXT MAM 2M
+102 ;;BR RESULT UNSATISFACTORY, NEXT MAM 3M
+103 ;;BR RESULT UNSATISFACTORY, NEXT MAM 4M
+104 ;;BR RESULT UNSATISFACTORY, NEXT MAM 5M
+105 ;;BR RESULT UNSATISFACTORY, NEXT MAM 6M
+106 ;;BR UNSATISFACTORY BIOPSY ALREADY OBTAIN
+107 ;;BR UNSATISFACTORY CONSULT
+108 ;;BR UNSATISFACTORY CURRENTLY UNDER TREATMENT
+109 ;;BR UNSATISFACTORY OBTAIN PRIOR FILMS
+110 ;;BR UNSATISFACTORY REFER FOR BIOPSY
+111 ;;BR UNSATISFACTORY REFER TO ONCOLOGIST
+112 ;;BR UNSATISFACTORY REFER TO SURGEON
+113 ;;BR UNSATISFACTORY, ORDER MRI
+114 ;;BR UNSATISFACTORY, ORDER ULTRASOUND
+115 ;;MAM unsatisfactory, need repeat
+116 ;;BR BIRAD 1, next MAM AGE AT START AGE
+117 ;;BR BIRAD 1, next MAM AGE 1Y
+118 ;;BR BIRAD 1, next MAM AGE 2Y
+119 ;;BR BIRAD 2, next MAM AGE AT START AGE
+120 ;;BR BIRAD 2, next MAM AGE 1Y
+121 ;;BR BIRAD 2, next MAM AGE 2Y
+122 ;;BR NEM, next MAM AGE AT START AGE
+123 ;;BR NEM, next MAM AGE 1Y
+124 ;;BR NEM, next MAM AGE 2Y
+125 ;;BR RETURN FOR MAM AT START AGE
+126 ;;BR RETURN FOR MAM 1Y
+127 QUIT
+128 ;
TRANS ;
+1 ;;162
+2 ;;163
+3 ;;164
+4 ;;165
+5 ;;166
+6 ;;167
+7 ;;168
+8 QUIT
+9 ;
TYPELIST ;
+1 ;;CONVERSATION WITH PATIENT
+2 ;;LETTER (CERTIFIED)
+3 ;;LETTER, FIRST
+4 ;;PHONE CALL, 1ST
+5 ;;SECURE MESSAGING
+6 QUIT
+7 ;
