- WV1032P ;ISP/AGP - PATCH 32 INSTALLATION TASKS;Oct 24, 2023@15:18:53
- ;;1.0;WOMEN'S HEALTH;**32**;Sep 30, 1998;Build 7
- Q
- ;
- PRE ;
- D RENAME
- Q
- ;
- POST ;
- D REINDEX
- Q
- ;
- REINDEX ;
- N DIK
- D BMES^XPDUTL("Reindexing file WV RESULTS/DIAGNOSIS")
- S DIK="^WV(790.31,"
- D IXALL2^DIK
- D IXALL^DIK
- D BMES^XPDUTL(" Done")
- Q
- ;
- RENAME ;
- N DA
- D BMES^XPDUTL("Renaming WV RESULTS/DIAGNOSIS entries")
- S DA=+$O(^WV(790.31,"B","BI-RADS CATEGORY 0","")) I DA>0 D
- .D BMES^XPDUTL(" BI-RADS CATEGORY 0 to BI-RADS CATEGORY 0 Need Additional Imaging Evaluation")
- .S $P(^WV(790.31,DA,0),U)="BI-RADS CATEGORY 0 Need Additional Imaging Evaluation"
- .K ^WV(790.31,"B","BI-RADS CATEGORY 0",DA)
- .S ^WV(790.31,"B","BI-RADS CATEGORY 0 Need Additional Imaging Evaluation",DA)=""
- D BMES^XPDUTL(" Done")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWV1032P 818 printed Mar 13, 2025@21:51:20 Page 2
- WV1032P ;ISP/AGP - PATCH 32 INSTALLATION TASKS;Oct 24, 2023@15:18:53
- +1 ;;1.0;WOMEN'S HEALTH;**32**;Sep 30, 1998;Build 7
- +2 QUIT
- +3 ;
- PRE ;
- +1 DO RENAME
- +2 QUIT
- +3 ;
- POST ;
- +1 DO REINDEX
- +2 QUIT
- +3 ;
- REINDEX ;
- +1 NEW DIK
- +2 DO BMES^XPDUTL("Reindexing file WV RESULTS/DIAGNOSIS")
- +3 SET DIK="^WV(790.31,"
- +4 DO IXALL2^DIK
- +5 DO IXALL^DIK
- +6 DO BMES^XPDUTL(" Done")
- +7 QUIT
- +8 ;
- RENAME ;
- +1 NEW DA
- +2 DO BMES^XPDUTL("Renaming WV RESULTS/DIAGNOSIS entries")
- +3 SET DA=+$ORDER(^WV(790.31,"B","BI-RADS CATEGORY 0",""))
- IF DA>0
- Begin DoDot:1
- +4 DO BMES^XPDUTL(" BI-RADS CATEGORY 0 to BI-RADS CATEGORY 0 Need Additional Imaging Evaluation")
- +5 SET $PIECE(^WV(790.31,DA,0),U)="BI-RADS CATEGORY 0 Need Additional Imaging Evaluation"
- +6 KILL ^WV(790.31,"B","BI-RADS CATEGORY 0",DA)
- +7 SET ^WV(790.31,"B","BI-RADS CATEGORY 0 Need Additional Imaging Evaluation",DA)=""
- End DoDot:1
- +8 DO BMES^XPDUTL(" Done")
- +9 QUIT
