RMPRFFIX ;VMP/RB - FIX FIELD LENGTH PROBLEMS FOR FILES #660/664 ;01/13/06
;;3.0;Prosthetics;**124**;06/20/05;Build 17
;;
;1. Post install to correct fields with length error created during
; cut & paste for function key input during GUI process and passed
; to VISTA files 660 and 664 for fields: Brief Description, Remarks,
; Serial #, Manufacturer, Model and Lot #
;
BEG ;search and correct length in errors for specified fields in files 664/660
RD1 S IEN4=0,FILE2="^RMPR(660,",END=0,TT=0,TFND=0,TFIX=0,RMPRCT1=0,RMPRCT2=0
RD1A S IEN4=$O(^RMPR(664,IEN4)),HIEN=0 G EXIT:IEN4=""!(IEN4]"A")
RD1AA S DIC="^RMPR(664,",DA=IEN4,DR="7.5;1;7.5;10;13;19;21.1",DIQ="D664",DIQ(0)="IE" D EN^DIQ1
S IEN0=$G(D664(664,IEN4,13,"I")),IEN42=0,HDT="",DFN=$G(D664(664,IEN4,1,"E")),RMUSER=$G(D664(664,IEN4,10,"I")),RMIFCAP=$G(D664(664,IEN4,7.5,"I"))
S IWD="*SHIPPING* LINK",PCN=$G(D664(664,IEN4,7.5,"I")),FLD19=$G(D664(664,IEN4,19,"I")),FLD211=$G(D664(664,IEN4,21.1,"I"))
K DIC,DA,DR,DIQ,D664
S IEN42=0,FILE1="^RMPR(664,"
D:IEN0>0 FIX660 G EXIT:END=1
RD1B S IEN42=$O(^RMPR(664,IEN4,1,IEN42)),HSW=0,NUM=IEN4_"-"_IEN42 I IEN42=""!(IEN42="B") G RD1A:RMOPT=1,ENTR
S DIC="^RMPR(664,",DA=IEN4,DA(664.02)=IEN42,DR=2,DR(664.02)="1;7;12;15;15.2;15.4;15.6",DIQ="D664",DIQ(0)="I" D EN^DIQ1
S FLD1D=$G(D664(664.02,IEN42,1,"I")),FLD7=$G(D664(664.02,IEN42,7,"I")),FLD15=$G(D664(664.02,IEN42,15,"I")),IEN0=$G(D664(664.02,IEN42,12,"I")),IWD="ITEM "_IEN42_": "_$E(FLD1D,1,30)
S FLD152=$G(D664(664.02,IEN42,15.2,"I")),FLD154=$G(D664(664.02,IEN42,15.4,"I")),FLD156=$G(D664(664.02,IEN42,15.6,"I"))
K DIC,DA,DR,DIQ,D664
I IEN42<2,$L(FLD19)>30 S WDA=NUM,WDB="664-19 (Deliver To)",WDC=FLD19 D G ENTR:END=1
. S FLD1=19,FLD2="",DA1=IEN4,DA1A="",DA2="",LMIN=3,LMAX=30,WDS="Deliver To"
. D ASK Q:END=1 D FILE
I IEN42<2,$L(FLD211)>45 S WDA=NUM,WDB="664-21.1 (Deliver To Attention)",WDC=FLD211 D G ENTR:END=1
. S FLD1=21.1,FLD2=25,DA1=IEN4,DA1A="",DA2=IEN0,LMIN=0,LMAX=45,WDS="Deliver To Attention"
. D ASK Q:END=1 D FILE
I IEN42>1,HDT'="" D
. S FLD2=25,DA1="",DA1A="",DA2=IEN0,DATA=HDT
. D FILE
S FILE1="^RMPR(664,IEN4,1,"
I $L(FLD1D)>60 S WDA=NUM,WDB="664-1 (Brief Description)",WDC=FLD1D D G ENTR:END=1
. S FLD1=1,FLD2=24,DA1=IEN42,DA1A=IEN4,DA2=IEN0,LMIN=3,LMAX=60,WDS="Brief Description"
. D ASK Q:END=1 D FILE
I $L(FLD7)>30 S WDA=NUM,WDB="664-7 (Remarks)",WDC=FLD7 D G ENTR:END=1
. S FLD1=7,FLD2=16,DA1=IEN42,DA1A=IEN4,DA2=IEN0,LMIN=0,LMAX=30,WDS="Remarks"
. D ASK Q:END=1 D FILE
I $L(FLD15)>15 S WDA=NUM,WDB="664-15 (Serial #)",WDC=FLD15 D G ENTR:END=1
. S FLD1=15,FLD2=9,DA1=IEN42,DA1A=IEN4,DA2=IEN0,LMIN=3,LMAX=15,WDS="SERIAL #"
. D ASK Q:END=1 D FILE
I $L(FLD152)>30 S WDA=NUM,WDB="664-15.2 (Manufacturer)",WDC=FLD152 D G ENTR:END=1
. S FLD1=15.2,FLD2=9.1,DA1=IEN42,DA1A=IEN4,DA2=IEN0,LMIN=0,LMAX=30,WDS="Manufacturer"
. D ASK Q:END=1 D FILE
I $L(FLD154)>30 S WDA=NUM,WDB="664-15.4 (Model)",WDC=FLD154 D G ENTR:END=1
. S FLD1=15.4,FLD2=9.2,DA1=IEN42,DA1A=IEN4,DA2=IEN0,LMIN=0,LMAX=30,WDS="Model"
. D ASK Q:END=1 D FILE
I $L(FLD156)>30 S WDA=NUM,WDB="664-15.6 (Lot #)",WDC=FLD156 D G ENTR:END=1
. S FLD1=15.6,FLD2=21,DA1=IEN42,DA1A=IEN4,DA2=IEN0,LMIN=0,LMAX=30,WDS="Lot #"
. D ASK Q:END=1 D FILE
G RD1B
FIX660 ;search and correct length in errors for specified fields in files 660
S HSW=0
S DIC="^RMPR(660,",DA=IEN0,DR="9;16;21;24:25;9.1;9.2",DIQ="D660",DIQ(0)="I" D EN^DIQ1
S FLD16=$G(D660(660,IEN0,16,"I")),FLD9=$G(D660(660,IEN0,9,"I")),FLD21=$G(D660(660,IEN0,21,"I"))
S FLD24=$G(D660(660,IEN0,24,"I")),FLD91=$G(D660(660,IEN0,9.1,"I")),FLD92=$G(D660(660,IEN0,9.2,"I"))
S FLD25=$G(D660(660,IEN0,25,"I"))
K DIC,DA,DR,DIQ,D660
I $L(FLD25)>30 S WDA=IEN0,WDB="660-25 (Deliver To)",WDC=FLD25 D G ENTR:END=1
. S FLD2=25,DA2=IEN0,LMIN=3,LMAX=30,WDS="(Pros/Appliance Repair) Deliver To"
. D ASK Q:END=1 D FILE
I $L(FLD24)>60 S WDA=IEN0,WDB="660-24 (Brief Description)",WDC=FLD24 D G ENTR:END=1
. S FLD2=24,DA2=IEN0,LMIN=3,LMAX=60,WDS="(Pros/Appliance Repair) Brief Description"
. D ASK Q:END=1 D FILE
I $L(FLD16)>61 S WDA=IEN0,WDB="660-16 (Remarks)",WDC=FLD16 D G ENTR:END=1
. S FLD2=16,DA2=IEN0,LMIN=0,LMAX=61,WDS="(Pros/Appliance Repair) Remarks"
. D ASK Q:END=1 D FILE
I $L(FLD9)>20 S WDA=IEN0,WDB="660-9 (Serial #)",WDC=FLD9 D G ENTR:END=1
. S FLD2=9,DA2=IEN0,LMIN=0,LMAX=20,WDS="(Pros/Appliance Repair) Serial #"
. D ASK Q:END=1 D FILE
I $L(FLD21)>20 S WDA=IEN0,WDB="660-21 (Lot #)",WDC=FLD21 D G ENTR:END=1
. S FLD2=21,DA2=IEN0,LMIN=0,LMAX=20,WDS="(Pros/Appliance Repair) Lot #"
. D ASK Q:END=1 D FILE
I $L(FLD91)>55 S WDA=IEN0,WDB="660-91 (Manufacturer)",WDC=FLD91 D G ENTR:END=1
. S FLD2=9.1,DA2=IEN0,LMIN=0,LMAX=55,WDS="(Pros/Appliance Repair) Manufacturer"
. D ASK Q:END=1 D FILE
I $L(FLD92)>55 S WDA=IEN0,WDB="660-92 (Model)",WDC=FLD92 D G ENTR:END=1
. S FLD2=9.2,DA2=IEN0,LMIN=0,LMAX=55,WDS="(Pros/Appliance Repair) Model"
. D ASK Q:END=1 D FILE
Q
ASK I RMOPT=1 D Q
. S ^XTMP("RMPRFIX","RMPR",RMUSER,IEN4,IEN42,$P(WDB," "))=LMIN_U_LMAX_U_WDB_U_DFN_U_$L(WDC)_U_RMIFCAP_U_IWD_U_IEN4_U_IEN42_U_IEN0_U_WDA_U_WDC
. S ^XTMP("RMPRFIX","RMPR","A",IEN4)=""
. S RMPRCT2=RMPRCT2+1
. S:IEN4'=HIEN RMPRCT1=RMPRCT1+1,HIEN=IEN4
I HSW=0 W !,IEN4," / ",IEN0,?20,"PCN: ",PCN,?42,"ITEM: ",IWD
S HSW=1,TFND=TFND+1
;ASK NEW FIELD ENTRY WITH CORRECT LENGTH
W !,WDA,?12,WDB,!,WDC,!
S DIR("A")=WDS,DIR("?")=$S(LMIN=0:"Field length cannot exceed "_LMAX_" characters",1:"Field length must be "_LMIN_"-"_LMAX_" characters in length")
S DIR(0)="F^"_LMIN_":"_LMAX
W !,DIR("?"),!
D ^DIR
I $D(DUOUT)!$D(DIRUT) S END=1 Q
S DATA=Y
W !
Q
FILE Q:RMOPT=1
K DA,DR,DIE
I IEN42'=0,DA1'="" S DIE=FILE1,DA=DA1,DR=FLD1_"////^S X=DATA" S:DA1A DA(1)=DA1A D ^DIE K DA,DIE,DR
I $G(FLD1)=19 S HDT=DATA
Q:DA2=""!(FLD2="")
S DIE=FILE2,DA=DA2,DR=FLD2_"////^S X=DATA" D ^DIE K DA,DIE,DR
S TFIX=TFIX+1
Q
ENT ;ASK INT TO FIX
S IEN4=0,FILE2="^RMPR(660,",END=0,TFND=0,TFIX=0
ENTR ;664 INTERNAL FROM BUILD REPORT
S DIR("A")="RECORD IDENTIFIER",DIR("?")="Enter record identifier from build list to be corrected"
S DIR(0)="F"
W !,DIR("?"),!
D ^DIR
I $D(DUOUT)!$D(DIRUT) S END=1 Q
Q:Y=""
S IEN4=Y
I '$D(^XTMP("RMPRFIX","RMPR","A",Y)) W " ** NOT FOUND ON CORRECTION REPORT" G ENTR
W !
G RD1AA
EXIT Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRFFIX 6388 printed Sep 23, 2025@20:10:51 Page 2
RMPRFFIX ;VMP/RB - FIX FIELD LENGTH PROBLEMS FOR FILES #660/664 ;01/13/06
+1 ;;3.0;Prosthetics;**124**;06/20/05;Build 17
+2 ;;
+3 ;1. Post install to correct fields with length error created during
+4 ; cut & paste for function key input during GUI process and passed
+5 ; to VISTA files 660 and 664 for fields: Brief Description, Remarks,
+6 ; Serial #, Manufacturer, Model and Lot #
+7 ;
BEG ;search and correct length in errors for specified fields in files 664/660
RD1 SET IEN4=0
SET FILE2="^RMPR(660,"
SET END=0
SET TT=0
SET TFND=0
SET TFIX=0
SET RMPRCT1=0
SET RMPRCT2=0
RD1A SET IEN4=$ORDER(^RMPR(664,IEN4))
SET HIEN=0
if IEN4=""!(IEN4]"A")
GOTO EXIT
RD1AA SET DIC="^RMPR(664,"
SET DA=IEN4
SET DR="7.5;1;7.5;10;13;19;21.1"
SET DIQ="D664"
SET DIQ(0)="IE"
DO EN^DIQ1
+1 SET IEN0=$GET(D664(664,IEN4,13,"I"))
SET IEN42=0
SET HDT=""
SET DFN=$GET(D664(664,IEN4,1,"E"))
SET RMUSER=$GET(D664(664,IEN4,10,"I"))
SET RMIFCAP=$GET(D664(664,IEN4,7.5,"I"))
+2 SET IWD="*SHIPPING* LINK"
SET PCN=$GET(D664(664,IEN4,7.5,"I"))
SET FLD19=$GET(D664(664,IEN4,19,"I"))
SET FLD211=$GET(D664(664,IEN4,21.1,"I"))
+3 KILL DIC,DA,DR,DIQ,D664
+4 SET IEN42=0
SET FILE1="^RMPR(664,"
+5 if IEN0>0
DO FIX660
if END=1
GOTO EXIT
RD1B SET IEN42=$ORDER(^RMPR(664,IEN4,1,IEN42))
SET HSW=0
SET NUM=IEN4_"-"_IEN42
IF IEN42=""!(IEN42="B")
if RMOPT=1
GOTO RD1A
GOTO ENTR
+1 SET DIC="^RMPR(664,"
SET DA=IEN4
SET DA(664.02)=IEN42
SET DR=2
SET DR(664.02)="1;7;12;15;15.2;15.4;15.6"
SET DIQ="D664"
SET DIQ(0)="I"
DO EN^DIQ1
+2 SET FLD1D=$GET(D664(664.02,IEN42,1,"I"))
SET FLD7=$GET(D664(664.02,IEN42,7,"I"))
SET FLD15=$GET(D664(664.02,IEN42,15,"I"))
SET IEN0=$GET(D664(664.02,IEN42,12,"I"))
SET IWD="ITEM "_IEN42_": "_$EXTRACT(FLD1D,1,30)
+3 SET FLD152=$GET(D664(664.02,IEN42,15.2,"I"))
SET FLD154=$GET(D664(664.02,IEN42,15.4,"I"))
SET FLD156=$GET(D664(664.02,IEN42,15.6,"I"))
+4 KILL DIC,DA,DR,DIQ,D664
+5 IF IEN42<2
IF $LENGTH(FLD19)>30
SET WDA=NUM
SET WDB="664-19 (Deliver To)"
SET WDC=FLD19
Begin DoDot:1
+6 SET FLD1=19
SET FLD2=""
SET DA1=IEN4
SET DA1A=""
SET DA2=""
SET LMIN=3
SET LMAX=30
SET WDS="Deliver To"
+7 DO ASK
if END=1
QUIT
DO FILE
End DoDot:1
if END=1
GOTO ENTR
+8 IF IEN42<2
IF $LENGTH(FLD211)>45
SET WDA=NUM
SET WDB="664-21.1 (Deliver To Attention)"
SET WDC=FLD211
Begin DoDot:1
+9 SET FLD1=21.1
SET FLD2=25
SET DA1=IEN4
SET DA1A=""
SET DA2=IEN0
SET LMIN=0
SET LMAX=45
SET WDS="Deliver To Attention"
+10 DO ASK
if END=1
QUIT
DO FILE
End DoDot:1
if END=1
GOTO ENTR
+11 IF IEN42>1
IF HDT'=""
Begin DoDot:1
+12 SET FLD2=25
SET DA1=""
SET DA1A=""
SET DA2=IEN0
SET DATA=HDT
+13 DO FILE
End DoDot:1
+14 SET FILE1="^RMPR(664,IEN4,1,"
+15 IF $LENGTH(FLD1D)>60
SET WDA=NUM
SET WDB="664-1 (Brief Description)"
SET WDC=FLD1D
Begin DoDot:1
+16 SET FLD1=1
SET FLD2=24
SET DA1=IEN42
SET DA1A=IEN4
SET DA2=IEN0
SET LMIN=3
SET LMAX=60
SET WDS="Brief Description"
+17 DO ASK
if END=1
QUIT
DO FILE
End DoDot:1
if END=1
GOTO ENTR
+18 IF $LENGTH(FLD7)>30
SET WDA=NUM
SET WDB="664-7 (Remarks)"
SET WDC=FLD7
Begin DoDot:1
+19 SET FLD1=7
SET FLD2=16
SET DA1=IEN42
SET DA1A=IEN4
SET DA2=IEN0
SET LMIN=0
SET LMAX=30
SET WDS="Remarks"
+20 DO ASK
if END=1
QUIT
DO FILE
End DoDot:1
if END=1
GOTO ENTR
+21 IF $LENGTH(FLD15)>15
SET WDA=NUM
SET WDB="664-15 (Serial #)"
SET WDC=FLD15
Begin DoDot:1
+22 SET FLD1=15
SET FLD2=9
SET DA1=IEN42
SET DA1A=IEN4
SET DA2=IEN0
SET LMIN=3
SET LMAX=15
SET WDS="SERIAL #"
+23 DO ASK
if END=1
QUIT
DO FILE
End DoDot:1
if END=1
GOTO ENTR
+24 IF $LENGTH(FLD152)>30
SET WDA=NUM
SET WDB="664-15.2 (Manufacturer)"
SET WDC=FLD152
Begin DoDot:1
+25 SET FLD1=15.2
SET FLD2=9.1
SET DA1=IEN42
SET DA1A=IEN4
SET DA2=IEN0
SET LMIN=0
SET LMAX=30
SET WDS="Manufacturer"
+26 DO ASK
if END=1
QUIT
DO FILE
End DoDot:1
if END=1
GOTO ENTR
+27 IF $LENGTH(FLD154)>30
SET WDA=NUM
SET WDB="664-15.4 (Model)"
SET WDC=FLD154
Begin DoDot:1
+28 SET FLD1=15.4
SET FLD2=9.2
SET DA1=IEN42
SET DA1A=IEN4
SET DA2=IEN0
SET LMIN=0
SET LMAX=30
SET WDS="Model"
+29 DO ASK
if END=1
QUIT
DO FILE
End DoDot:1
if END=1
GOTO ENTR
+30 IF $LENGTH(FLD156)>30
SET WDA=NUM
SET WDB="664-15.6 (Lot #)"
SET WDC=FLD156
Begin DoDot:1
+31 SET FLD1=15.6
SET FLD2=21
SET DA1=IEN42
SET DA1A=IEN4
SET DA2=IEN0
SET LMIN=0
SET LMAX=30
SET WDS="Lot #"
+32 DO ASK
if END=1
QUIT
DO FILE
End DoDot:1
if END=1
GOTO ENTR
+33 GOTO RD1B
FIX660 ;search and correct length in errors for specified fields in files 660
+1 SET HSW=0
+2 SET DIC="^RMPR(660,"
SET DA=IEN0
SET DR="9;16;21;24:25;9.1;9.2"
SET DIQ="D660"
SET DIQ(0)="I"
DO EN^DIQ1
+3 SET FLD16=$GET(D660(660,IEN0,16,"I"))
SET FLD9=$GET(D660(660,IEN0,9,"I"))
SET FLD21=$GET(D660(660,IEN0,21,"I"))
+4 SET FLD24=$GET(D660(660,IEN0,24,"I"))
SET FLD91=$GET(D660(660,IEN0,9.1,"I"))
SET FLD92=$GET(D660(660,IEN0,9.2,"I"))
+5 SET FLD25=$GET(D660(660,IEN0,25,"I"))
+6 KILL DIC,DA,DR,DIQ,D660
+7 IF $LENGTH(FLD25)>30
SET WDA=IEN0
SET WDB="660-25 (Deliver To)"
SET WDC=FLD25
Begin DoDot:1
+8 SET FLD2=25
SET DA2=IEN0
SET LMIN=3
SET LMAX=30
SET WDS="(Pros/Appliance Repair) Deliver To"
+9 DO ASK
if END=1
QUIT
DO FILE
End DoDot:1
if END=1
GOTO ENTR
+10 IF $LENGTH(FLD24)>60
SET WDA=IEN0
SET WDB="660-24 (Brief Description)"
SET WDC=FLD24
Begin DoDot:1
+11 SET FLD2=24
SET DA2=IEN0
SET LMIN=3
SET LMAX=60
SET WDS="(Pros/Appliance Repair) Brief Description"
+12 DO ASK
if END=1
QUIT
DO FILE
End DoDot:1
if END=1
GOTO ENTR
+13 IF $LENGTH(FLD16)>61
SET WDA=IEN0
SET WDB="660-16 (Remarks)"
SET WDC=FLD16
Begin DoDot:1
+14 SET FLD2=16
SET DA2=IEN0
SET LMIN=0
SET LMAX=61
SET WDS="(Pros/Appliance Repair) Remarks"
+15 DO ASK
if END=1
QUIT
DO FILE
End DoDot:1
if END=1
GOTO ENTR
+16 IF $LENGTH(FLD9)>20
SET WDA=IEN0
SET WDB="660-9 (Serial #)"
SET WDC=FLD9
Begin DoDot:1
+17 SET FLD2=9
SET DA2=IEN0
SET LMIN=0
SET LMAX=20
SET WDS="(Pros/Appliance Repair) Serial #"
+18 DO ASK
if END=1
QUIT
DO FILE
End DoDot:1
if END=1
GOTO ENTR
+19 IF $LENGTH(FLD21)>20
SET WDA=IEN0
SET WDB="660-21 (Lot #)"
SET WDC=FLD21
Begin DoDot:1
+20 SET FLD2=21
SET DA2=IEN0
SET LMIN=0
SET LMAX=20
SET WDS="(Pros/Appliance Repair) Lot #"
+21 DO ASK
if END=1
QUIT
DO FILE
End DoDot:1
if END=1
GOTO ENTR
+22 IF $LENGTH(FLD91)>55
SET WDA=IEN0
SET WDB="660-91 (Manufacturer)"
SET WDC=FLD91
Begin DoDot:1
+23 SET FLD2=9.1
SET DA2=IEN0
SET LMIN=0
SET LMAX=55
SET WDS="(Pros/Appliance Repair) Manufacturer"
+24 DO ASK
if END=1
QUIT
DO FILE
End DoDot:1
if END=1
GOTO ENTR
+25 IF $LENGTH(FLD92)>55
SET WDA=IEN0
SET WDB="660-92 (Model)"
SET WDC=FLD92
Begin DoDot:1
+26 SET FLD2=9.2
SET DA2=IEN0
SET LMIN=0
SET LMAX=55
SET WDS="(Pros/Appliance Repair) Model"
+27 DO ASK
if END=1
QUIT
DO FILE
End DoDot:1
if END=1
GOTO ENTR
+28 QUIT
ASK IF RMOPT=1
Begin DoDot:1
+1 SET ^XTMP("RMPRFIX","RMPR",RMUSER,IEN4,IEN42,$PIECE(WDB," "))=LMIN_U_LMAX_U_WDB_U_DFN_U_$LENGTH(WDC)_U_RMIFCAP_U_IWD_U_IEN4_U_IEN42_U_IEN0_U_WDA_U_WDC
+2 SET ^XTMP("RMPRFIX","RMPR","A",IEN4)=""
+3 SET RMPRCT2=RMPRCT2+1
+4 if IEN4'=HIEN
SET RMPRCT1=RMPRCT1+1
SET HIEN=IEN4
End DoDot:1
QUIT
+5 IF HSW=0
WRITE !,IEN4," / ",IEN0,?20,"PCN: ",PCN,?42,"ITEM: ",IWD
+6 SET HSW=1
SET TFND=TFND+1
+7 ;ASK NEW FIELD ENTRY WITH CORRECT LENGTH
+8 WRITE !,WDA,?12,WDB,!,WDC,!
+9 SET DIR("A")=WDS
SET DIR("?")=$SELECT(LMIN=0:"Field length cannot exceed "_LMAX_" characters",1:"Field length must be "_LMIN_"-"_LMAX_" characters in length")
+10 SET DIR(0)="F^"_LMIN_":"_LMAX
+11 WRITE !,DIR("?"),!
+12 DO ^DIR
+13 IF $DATA(DUOUT)!$DATA(DIRUT)
SET END=1
QUIT
+14 SET DATA=Y
+15 WRITE !
+16 QUIT
FILE if RMOPT=1
QUIT
+1 KILL DA,DR,DIE
+2 IF IEN42'=0
IF DA1'=""
SET DIE=FILE1
SET DA=DA1
SET DR=FLD1_"////^S X=DATA"
if DA1A
SET DA(1)=DA1A
DO ^DIE
KILL DA,DIE,DR
+3 IF $GET(FLD1)=19
SET HDT=DATA
+4 if DA2=""!(FLD2="")
QUIT
+5 SET DIE=FILE2
SET DA=DA2
SET DR=FLD2_"////^S X=DATA"
DO ^DIE
KILL DA,DIE,DR
+6 SET TFIX=TFIX+1
+7 QUIT
ENT ;ASK INT TO FIX
+1 SET IEN4=0
SET FILE2="^RMPR(660,"
SET END=0
SET TFND=0
SET TFIX=0
ENTR ;664 INTERNAL FROM BUILD REPORT
+1 SET DIR("A")="RECORD IDENTIFIER"
SET DIR("?")="Enter record identifier from build list to be corrected"
+2 SET DIR(0)="F"
+3 WRITE !,DIR("?"),!
+4 DO ^DIR
+5 IF $DATA(DUOUT)!$DATA(DIRUT)
SET END=1
QUIT
+6 if Y=""
QUIT
+7 SET IEN4=Y
+8 IF '$DATA(^XTMP("RMPRFIX","RMPR","A",Y))
WRITE " ** NOT FOUND ON CORRECTION REPORT"
GOTO ENTR
+9 WRITE !
+10 GOTO RD1AA
EXIT QUIT
