source: FOIAVistA/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRFFIX.m@ 1688

Last change on this file since 1688 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.1 KB
Line 
1RMPRFFIX ;VMP/RB - FIX FIELD LENGTH PROBLEMS FOR FILES #660/664 ;01/13/06
2 ;;3.0;Prosthetics;**124**;06/20/05;Build 17
3 ;;
4 ;1. Post install to correct fields with length error created during
5 ; cut & paste for function key input during GUI process and passed
6 ; to VISTA files 660 and 664 for fields: Brief Description, Remarks,
7 ; Serial #, Manufacturer, Model and Lot #
8 ;
9BEG ;search and correct length in errors for specified fields in files 664/660
10RD1 S IEN4=0,FILE2="^RMPR(660,",END=0,TT=0,TFND=0,TFIX=0,RMPRCT1=0,RMPRCT2=0
11RD1A S IEN4=$O(^RMPR(664,IEN4)),HIEN=0 G EXIT:IEN4=""!(IEN4]"A")
12RD1AA 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
13 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"))
14 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"))
15 K DIC,DA,DR,DIQ,D664
16 S IEN42=0,FILE1="^RMPR(664,"
17 D:IEN0>0 FIX660 G EXIT:END=1
18RD1B S IEN42=$O(^RMPR(664,IEN4,1,IEN42)),HSW=0,NUM=IEN4_"-"_IEN42 I IEN42=""!(IEN42="B") G RD1A:RMOPT=1,ENTR
19 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
20 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)
21 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"))
22 K DIC,DA,DR,DIQ,D664
23 I IEN42<2,$L(FLD19)>30 S WDA=NUM,WDB="664-19 (Deliver To)",WDC=FLD19 D G ENTR:END=1
24 . S FLD1=19,FLD2="",DA1=IEN4,DA1A="",DA2="",LMIN=3,LMAX=30,WDS="Deliver To"
25 . D ASK Q:END=1 D FILE
26 I IEN42<2,$L(FLD211)>45 S WDA=NUM,WDB="664-21.1 (Deliver To Attention)",WDC=FLD211 D G ENTR:END=1
27 . S FLD1=21.1,FLD2=25,DA1=IEN4,DA1A="",DA2=IEN0,LMIN=0,LMAX=45,WDS="Deliver To Attention"
28 . D ASK Q:END=1 D FILE
29 I IEN42>1,HDT'="" D
30 . S FLD2=25,DA1="",DA1A="",DA2=IEN0,DATA=HDT
31 . D FILE
32 S FILE1="^RMPR(664,IEN4,1,"
33 I $L(FLD1D)>60 S WDA=NUM,WDB="664-1 (Brief Description)",WDC=FLD1D D G ENTR:END=1
34 . S FLD1=1,FLD2=24,DA1=IEN42,DA1A=IEN4,DA2=IEN0,LMIN=3,LMAX=60,WDS="Brief Description"
35 . D ASK Q:END=1 D FILE
36 I $L(FLD7)>30 S WDA=NUM,WDB="664-7 (Remarks)",WDC=FLD7 D G ENTR:END=1
37 . S FLD1=7,FLD2=16,DA1=IEN42,DA1A=IEN4,DA2=IEN0,LMIN=0,LMAX=30,WDS="Remarks"
38 . D ASK Q:END=1 D FILE
39 I $L(FLD15)>15 S WDA=NUM,WDB="664-15 (Serial #)",WDC=FLD15 D G ENTR:END=1
40 . S FLD1=15,FLD2=9,DA1=IEN42,DA1A=IEN4,DA2=IEN0,LMIN=3,LMAX=15,WDS="SERIAL #"
41 . D ASK Q:END=1 D FILE
42 I $L(FLD152)>30 S WDA=NUM,WDB="664-15.2 (Manufacturer)",WDC=FLD152 D G ENTR:END=1
43 . S FLD1=15.2,FLD2=9.1,DA1=IEN42,DA1A=IEN4,DA2=IEN0,LMIN=0,LMAX=30,WDS="Manufacturer"
44 . D ASK Q:END=1 D FILE
45 I $L(FLD154)>30 S WDA=NUM,WDB="664-15.4 (Model)",WDC=FLD154 D G ENTR:END=1
46 . S FLD1=15.4,FLD2=9.2,DA1=IEN42,DA1A=IEN4,DA2=IEN0,LMIN=0,LMAX=30,WDS="Model"
47 . D ASK Q:END=1 D FILE
48 I $L(FLD156)>30 S WDA=NUM,WDB="664-15.6 (Lot #)",WDC=FLD156 D G ENTR:END=1
49 . S FLD1=15.6,FLD2=21,DA1=IEN42,DA1A=IEN4,DA2=IEN0,LMIN=0,LMAX=30,WDS="Lot #"
50 . D ASK Q:END=1 D FILE
51 G RD1B
52FIX660 ;search and correct length in errors for specified fields in files 660
53 S HSW=0
54 S DIC="^RMPR(660,",DA=IEN0,DR="9;16;21;24:25;9.1;9.2",DIQ="D660",DIQ(0)="I" D EN^DIQ1
55 S FLD16=$G(D660(660,IEN0,16,"I")),FLD9=$G(D660(660,IEN0,9,"I")),FLD21=$G(D660(660,IEN0,21,"I"))
56 S FLD24=$G(D660(660,IEN0,24,"I")),FLD91=$G(D660(660,IEN0,9.1,"I")),FLD92=$G(D660(660,IEN0,9.2,"I"))
57 S FLD25=$G(D660(660,IEN0,25,"I"))
58 K DIC,DA,DR,DIQ,D660
59 I $L(FLD25)>30 S WDA=IEN0,WDB="660-25 (Deliver To)",WDC=FLD25 D G ENTR:END=1
60 . S FLD2=25,DA2=IEN0,LMIN=3,LMAX=30,WDS="(Pros/Appliance Repair) Deliver To"
61 . D ASK Q:END=1 D FILE
62 I $L(FLD24)>60 S WDA=IEN0,WDB="660-24 (Brief Description)",WDC=FLD24 D G ENTR:END=1
63 . S FLD2=24,DA2=IEN0,LMIN=3,LMAX=60,WDS="(Pros/Appliance Repair) Brief Description"
64 . D ASK Q:END=1 D FILE
65 I $L(FLD16)>61 S WDA=IEN0,WDB="660-16 (Remarks)",WDC=FLD16 D G ENTR:END=1
66 . S FLD2=16,DA2=IEN0,LMIN=0,LMAX=61,WDS="(Pros/Appliance Repair) Remarks"
67 . D ASK Q:END=1 D FILE
68 I $L(FLD9)>20 S WDA=IEN0,WDB="660-9 (Serial #)",WDC=FLD9 D G ENTR:END=1
69 . S FLD2=9,DA2=IEN0,LMIN=0,LMAX=20,WDS="(Pros/Appliance Repair) Serial #"
70 . D ASK Q:END=1 D FILE
71 I $L(FLD21)>20 S WDA=IEN0,WDB="660-21 (Lot #)",WDC=FLD21 D G ENTR:END=1
72 . S FLD2=21,DA2=IEN0,LMIN=0,LMAX=20,WDS="(Pros/Appliance Repair) Lot #"
73 . D ASK Q:END=1 D FILE
74 I $L(FLD91)>55 S WDA=IEN0,WDB="660-91 (Manufacturer)",WDC=FLD91 D G ENTR:END=1
75 . S FLD2=9.1,DA2=IEN0,LMIN=0,LMAX=55,WDS="(Pros/Appliance Repair) Manufacturer"
76 . D ASK Q:END=1 D FILE
77 I $L(FLD92)>55 S WDA=IEN0,WDB="660-92 (Model)",WDC=FLD92 D G ENTR:END=1
78 . S FLD2=9.2,DA2=IEN0,LMIN=0,LMAX=55,WDS="(Pros/Appliance Repair) Model"
79 . D ASK Q:END=1 D FILE
80 Q
81ASK I RMOPT=1 D Q
82 . 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
83 . S ^XTMP("RMPRFIX","RMPR","A",IEN4)=""
84 . S RMPRCT2=RMPRCT2+1
85 . S:IEN4'=HIEN RMPRCT1=RMPRCT1+1,HIEN=IEN4
86 I HSW=0 W !,IEN4," / ",IEN0,?20,"PCN: ",PCN,?42,"ITEM: ",IWD
87 S HSW=1,TFND=TFND+1
88 ;ASK NEW FIELD ENTRY WITH CORRECT LENGTH
89 W !,WDA,?12,WDB,!,WDC,!
90 S DIR("A")=WDS,DIR("?")=$S(LMIN=0:"Field length cannot exceed "_LMAX_" characters",1:"Field length must be "_LMIN_"-"_LMAX_" characters in length")
91 S DIR(0)="F^"_LMIN_":"_LMAX
92 W !,DIR("?"),!
93 D ^DIR
94 I $D(DUOUT)!$D(DIRUT) S END=1 Q
95 S DATA=Y
96 W !
97 Q
98FILE Q:RMOPT=1
99 K DA,DR,DIE
100 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
101 I $G(FLD1)=19 S HDT=DATA
102 Q:DA2=""!(FLD2="")
103 S DIE=FILE2,DA=DA2,DR=FLD2_"////^S X=DATA" D ^DIE K DA,DIE,DR
104 S TFIX=TFIX+1
105 Q
106ENT ;ASK INT TO FIX
107 S IEN4=0,FILE2="^RMPR(660,",END=0,TFND=0,TFIX=0
108ENTR ;664 INTERNAL FROM BUILD REPORT
109 S DIR("A")="RECORD IDENTIFIER",DIR("?")="Enter record identifier from build list to be corrected"
110 S DIR(0)="F"
111 W !,DIR("?"),!
112 D ^DIR
113 I $D(DUOUT)!$D(DIRUT) S END=1 Q
114 Q:Y=""
115 S IEN4=Y
116 I '$D(^XTMP("RMPRFIX","RMPR","A",Y)) W " ** NOT FOUND ON CORRECTION REPORT" G ENTR
117 W !
118 G RD1AA
119EXIT Q
Note: See TracBrowser for help on using the repository browser.